RSY-MC1
Patrick Schürmann, Si Ben Tran
- Mini-Challenge Beschreibung
- Daten und Libraries
- Daten einlesen
- Library Methoden zum Datensatz MovieLense
- MovieLense Dataframe erstellen
- Kopfzeile und Fusszeile vom Datensatz ausgeben
- Infos zum Datensatz
- 1 Explorative Datenanalyse
- 1.1 Welches sind die am häufigsten geschauten Genres/Filme?
- 1.2 Wie verteilen sich die Kundenratings gesamthaft und nach Genres?
- 1.3 Wie verteilen sich die mittleren Kundenratings pro Film?
- 1.4 Wie stark streuen die Ratings von individuellen Kunden?
- 1.5 Welchen Einfluss hat die Normierung der Ratings pro Kunde auf deren Verteilung?
- 1.6 Welche strukturellen Charakteristika (z.B. Sparsity) und Auffälligkeiten zeigt die User-Item Matrix?
- 2 Datenreduktion
- 3 Analyse Ähnlichkeitsmatrix
- 3.1 Zerlege den reduzierten MovieLense Datensatz in ein disjunktes Trainings-und Testdatenset im Verhältnis 4:1,
- 3.2 Trainiere ein IBCF Modell mit 30 Nachbarn und Cosine Similarity
- 3.3 Bestimme die Verteilung der Filme, welche bei IBCF für paarweise Ähnlichkeitsvergleiche verwendet werden
- 3.4 Bestimme die Filme, die am häufigsten in der Cosine-Ähnlichkeitsmatrix auftauchen und analysiere deren Vorkommen und Ratings im reduzierten Datensatz.
- 4 Implementierung Ähnlichkeitsmatrix
- 5 Analyse Top-N Listen - IBCF vs UBCF
- 6 Analyse Top-N Listen - Ratings
- 7 Analyse Top-N Listen - IBCF vs SVD
- 8 Implementierung Top-N Metriken
- 9 Wahl des optimalen Recommenders
- 10 Implementierung Top-N
Monitor
- 10.1 Fixiere 20 zufällig gewählte Testkunden für alle Modellvergleiche,
- 10.2 Bestimme den Anteil der Top-N Empfehlung nach Genres pro Kunde,
- 10.3 Bestimme pro Kunde den Anteil nach Genres seiner Top-Filme
- 10.4 Vergleiche pro Kunde Top-Empfehlungen vs Top-Filme nach Genres,
- 10.5 Definiere eine Qualitätsmetrik für Top-N Listen und teste sie.
Mini-Challenge Beschreibung
Daten und Libraries
library(tidyverse)## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6 ✔ purrr 0.3.4
## ✔ tibble 3.1.8 ✔ dplyr 1.0.10
## ✔ tidyr 1.2.1 ✔ stringr 1.4.1
## ✔ readr 2.1.2 ✔ forcats 0.5.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()library(recommenderlab)## Lade nötiges Paket: Matrix
##
## Attache Paket: 'Matrix'
##
## Die folgenden Objekte sind maskiert von 'package:tidyr':
##
## expand, pack, unpack
##
## Lade nötiges Paket: arules
##
## Attache Paket: 'arules'
##
## Das folgende Objekt ist maskiert 'package:dplyr':
##
## recode
##
## Die folgenden Objekte sind maskiert von 'package:base':
##
## abbreviate, write
##
## Lade nötiges Paket: proxy
##
## Attache Paket: 'proxy'
##
## Das folgende Objekt ist maskiert 'package:Matrix':
##
## as.matrix
##
## Die folgenden Objekte sind maskiert von 'package:stats':
##
## as.dist, dist
##
## Das folgende Objekt ist maskiert 'package:base':
##
## as.matrix
##
## Lade nötiges Paket: registry
## Registered S3 methods overwritten by 'registry':
## method from
## print.registry_field proxy
## print.registry_entry proxylibrary(gridExtra)## Warning: Paket 'gridExtra' wurde unter R Version 4.2.2 erstellt##
## Attache Paket: 'gridExtra'
##
## Das folgende Objekt ist maskiert 'package:dplyr':
##
## combineDaten einlesen
data(MovieLense)Beim Einlesen des Datensatzes werden drei realRatingMatrix eingelesen: MovieLense, MovieLenseMeta und MovieLenseUser. Wir untersuchen nun zuerst MovieLense.
Library Methoden zum Datensatz MovieLense
methods(class = class(MovieLense))## [1] [ [<- binarize
## [4] calcPredictionAccuracy coerce colCounts
## [7] colMeans colSds colSums
## [10] denormalize dim dimnames
## [13] dimnames<- dissimilarity evaluationScheme
## [16] getData.frame getList getNormalize
## [19] getRatingMatrix getRatings getTopNLists
## [22] hasRating image normalize
## [25] nratings Recommender removeKnownRatings
## [28] rowCounts rowMeans rowSds
## [31] rowSums sample show
## [34] similarity
## see '?methods' for accessing help and source codeDiese Übersicht zeigt uns, welche Methoden mit der realRatingMatrix in Kombination mit Recommenderlab möglich sind.
MovieLense Dataframe erstellen
MovieLenseEDA <- as(MovieLense, "data.frame")Um den EDA-Teil lösen zu können, haben wir die realRatingMatrix in einen data.frame umgewandelt.
Kopfzeile und Fusszeile vom Datensatz ausgeben
head(MovieLenseEDA)tail(MovieLenseEDA)Um eine Idee der Daten zu erhalten, haben wir den Head und Tail des Dataframes ausgegeben. Es wird ersichtlich, dass für jede Zeile ein User, Item (Film) und das Rating erfasst sind.
Infos zum Datensatz
summary(MovieLenseEDA)## user item rating
## Length:99392 Length:99392 Min. :1.00
## Class :character Class :character 1st Qu.:3.00
## Mode :character Mode :character Median :4.00
## Mean :3.53
## 3rd Qu.:4.00
## Max. :5.00Mit der Summary Funktion haben wir uns einen Überblick über die Zahlen im Datensatz erschaffen. Es sind jeweils 99’392 User und Items erfasst. Die Ratings reichen vom Bereich 1 bis 5 und der Mittelwert beträgt 3.53 (Median 4.0)
1 Explorative Datenanalyse
Aufgabe 1: Untersuche den vollständigen MovieLense Datensatz (d.h. vor Datenreduktion!) und beantworte folgende Fragen:
1.1 Welches sind die am häufigsten geschauten Genres/Filme?
1.1.1 Welches sind die am häufigsten geschauten Filme?
MovieLenseEDA %>%
group_by(item) %>%
summarise(Anzahl = n()) %>%
arrange(desc(Anzahl)) %>%
head(n=10)Diese Tabelle zeigt uns die Top-10 der am meisten geschauten, resp. gerateten Filme. Es wird ersichtlich, dass Star Wars (1977, vermutlich “Krieg der Sterne”) 583 mal geschaut und geratet wurde.
1.1.2 Welches sind die am häufigsten geschauten Genre?
# Full Join mit df_movies_rating und MovieLenseMeta
MovieLenseEDA_Joined <- full_join(MovieLenseEDA, MovieLenseMeta,
by = c("item" = "title")) %>%
select(-c("user", "item", "rating", "year", "url"))
# Aufsummieren der Genre Spalten
(colSums(MovieLenseEDA_Joined)) %>% sort(decreasing = TRUE)## Drama Comedy Action Thriller Romance Adventure
## 39446 29778 25510 21808 19203 13688
## Sci-Fi War Crime Children's Horror Mystery
## 12694 9398 8027 7143 5280 5237
## Musical Animation Western Film-Noir Fantasy Documentary
## 4954 3605 1854 1733 1352 758
## unknown
## 10Wir erkennen, dass das am häufigsten geschauten Genre “Drama” mit 39’446 Ratings ist. Auf dem zweiten Platz befindet sich “Comdey” und auf dem dritten “Action”. Am wenigsten häufig wurden “Documentary” und “unknown” geschaut.
1.2 Wie verteilen sich die Kundenratings gesamthaft und nach Genres?
# DataFrame join
MovieLenseEDA_Joined <- full_join(MovieLenseEDA, MovieLenseMeta,
by = c("item" = "title"))Für diese Frage haben wir einen neuen Datensatz “MovieLenseEDA_Joined” erstellt. Er ergibt sich aus MovieLenseEDA und MovieLenseMeta. Folgend nun die Beantwortund der Frage.
1.2.1 Verteilung der Kundenratings Gesamthaft
MovieLenseEDA_Joined$rating <- as.factor(MovieLenseEDA_Joined$rating)
# Dataframe Uebersicht
MovieLenseEDA_Joined %>% group_by(rating) %>%
summarize(Anzahl = n())# Visuelle Darstellung mittels Barplot
MovieLenseEDA_Joined %>% group_by(rating) %>%
summarize(Anzahl = n()) %>%
ggplot(aes(x = rating, y = Anzahl)) +
geom_bar(stat = "identity",
fill = "lightblue",
color = "black") +
labs(x = "Ratings",
y = "Anzahl",
title = "Verteilung der Kundenratings Gesamthaft",
subtitle = paste("Gesamte Anzahl Kundenratings:", dim(MovieLenseEDA_Joined)[1]))
Wie wir in im Dataframe sowie im Barplot erkennen, werden am häufigsten
die Ratings 3 und 4 vergeben. Rating von 1 und 2 kommen deutlich weniger
vor, als möglicher Grund könnte sein, dass Filme die schlecht sind gar
nicht bewertet wurden, da man sich nicht mehr weiter mit schlechten
Filmen befassen möchte. Aus eigenen Erfahrungen können wir sagen, dass
man eher mehr bereit ist einen Film zu bewerten, wenn diese auch
wirklich gut ist. Das Rating 5 kommt am dritthäufigsten vor.
1.2.2 Verteilung der Kundenratings nach Genre
MovieLenseEDA_Joined$rating <- as.integer(MovieLenseEDA_Joined$rating)
MovieLenseEDA_Joined %>%
select(-c("item", "user", "year", "url")) %>%
pivot_longer(cols=c("unknown", "Action", "Adventure", "Animation", "Children's",
"Comedy", "Crime", "Documentary", "Drama", "Fantasy",
"Film-Noir", "Horror", "Musical", "Mystery", "Horror",
"Musical", "Mystery", "Romance", "Sci-Fi", "Thriller",
"War", "Western"),
names_to = "Genre", values_to = "is_genre") %>%
filter(is_genre == 1) %>%
ggplot(aes(x = rating)) +
geom_bar(fill = "lightblue", color = "black") +
labs(x = "Ratings",
y = "Anzahl",
title = "Verteilung der Kundenratings nach Genre",
subtitle = paste("Gesamte Anzahl Kundenratings:", dim(MovieLenseEDA_Joined)[1])) +
facet_wrap(~Genre)
In der Visualisierung der Verteilung der Kundenratings pro Genre
erkennen wir analog, wie bei der Verteilung der gesamthaften
Kundenratings, dass die Rating 3 und 4 am meisten vergeben werden.
Dieses Muster ist bei fast allen Genres erkennbar, einfach mit
unterschiedlicher Intensität (Anzahl Ratings).
1.3 Wie verteilen sich die mittleren Kundenratings pro Film?
# Dataframe
MovieLenseEDA %>%
group_by(item) %>%
summarize(mean_rating_per_film = mean(rating),
n_rating_per_film = n()) %>%
arrange(n_rating_per_film)# Visualisierung
MovieLenseEDA %>%
group_by(item) %>%
summarize(mean_rating_per_film = mean(rating)) %>%
ggplot(aes(x = mean_rating_per_film)) +
geom_histogram(color = "black", fill = "lightblue", binwidth = 0.1) +
labs(x = "Ratings",
y = "Anzahl",
title = "Verteilung der Mittleren Kundenratings pro Film",
subtitle = paste("Gesamte Anzahl Kundenratings:", dim(MovieLenseEDA)[1]))
Wir erkennen im Plot die Verteilung durchschnittliche Rating pro Film.
Auch hier ist erkennbar, dass die meisten Ratings zwischen 3 und 4
liegen. Einen Ausreisser gibt es beim Rating 1. Bei den
natürlichen/ganzzähligen Zahlen erkennen wir ein überraschendes Muster:
Die Anzahl erscheint jeweils höher als bei den umliegenden Ratings mit
Kommastellen. Dies liegt daran, dass es Filme gibt die nur eine oder
wenige Bewertungen bekommen haben (siehe ausgegebenes Datafarme).
1.4 Wie stark streuen die Ratings von individuellen Kunden?
MovieLenseEDA %>% filter(user == c(1:9)) %>%
ggplot(aes(x = user, y = rating)) +
geom_violin(color = "black", fill = "lightblue") +
labs(x = "User",
y = "Ratings",
title = "Streueung der Ratings von individuellen Kunden",
subtitle = "MovieLenseData, Kunden 1-9")
Im Violinenplot stellen wir die ersten 9 User und deren Rating
Verteilungen dar. Wir erkennen im Plot, dass User 2 und 8 Filme sehr
ähnliche bewerten. Beide bewerten Filme öfters mit einer 4 und eher
weniger eine 3 und 5, aber nie 2 und 1. User 5 und 9 bewerten Filme
hingegen im ganzen Bereich.
1.5 Welchen Einfluss hat die Normierung der Ratings pro Kunde auf deren Verteilung?
MovieLensenormalized <- normalize(MovieLense)
MovieLenseEDA_Normalized <- (as(MovieLensenormalized, "data.frame"))
MovieLenseEDA_Normalized %>% filter(user == c(1:9)) %>%
ggplot(aes(x = user, y = rating)) +
geom_violin(color = "black", fill = "lightblue") +
labs(x = "User",
y = "Normalisierte Ratings",
title = "Normalisierte Streueung der Ratings von individuellen Kunden",
subtitle = "MovieLenseData, Kunden 1 - 9")
Für die Normierung der Daten haben wir die Funktion von Recommenderlab
verwendet. Der Mittelwert der Ratings pro User beträgt nun Null. Im Plot
verschiebt sich nun nicht nur die y-Achse, sondern auch die Bandbreite.
user 5 und 9, die auf den Rohdaten 1-5 bewertet haben, haben nun
unterschiedliche Bandbreiten. Dies liegt daran, dass der Mittelwert der
beiden User unterschiedlich ist.
1.6 Welche strukturellen Charakteristika (z.B. Sparsity) und Auffälligkeiten zeigt die User-Item Matrix?
image(x = MovieLense,
xlab = "Items",
ylab = "Users",
main = "Sparisty 943 x 1664 User-Item Matrix 943 x 1664") 
image(MovieLense[1:50,1:50],
xlab = "Items",
ylab = "Users",
main = "Sparisty 50 x 50 User-Item Matrix")
# nratings(MovieLense) zaehlt die Anzahl vorhandenen Kombinationen von User und Items
(nratings(MovieLense) / (dim(MovieLense)[1] * dim(MovieLense)[2]) * 100)## [1] 6.334122Für die Darstellung der Sparsity haben wir die image Funktion von Recommenderlab verwendet. Jede Zeile von MovieLense entspricht einem Benutzer und jede Spalte einem Film und für jede geschaute Kombination wird ein Pixel in Graustufen, je nach Rating, markiert. Im ersten Plot wird ersichtlich, dass die ersten User weniger Filme bewertet haben, denn oben rechts sind keine Punkte mehr ersichtlich. Auch ist auffällig, dass die ersten etwa 500 häufiger geschaut wurden, denn bis zu diesem Bereich sind am meisten Pixel eingefärbt. Um die Darstellung genau verstehen zu können, haben wir im zweiten Plot nur die ersten 50 User und Items dargestellt. Dort ist die hohe Sparsity gut erkennbar. Gesamthaft gibt es 943 x 1664 = 1’569’152 Kombinationen zwischen User und Film. Allerdings hat nicht jeder Nutzer jeden Film gesehen, aus diesem Grund ist es wichtig die sparsity der Matrix zu betrachten. In MovieLense Matrix fehlen ca. 94% der Kombinationen. Nur für 6.3% der möglichen Kombinationen sind Ratings vorhanden.
2 Datenreduktion
Aufgabe 2: Reduziere den MovieLense Datensatz auf rund 400 Kunden und 700 Filme, indem du Filme und Kunden mit sehr wenigen Ratings entfernst.
2.1 Vorbereitung
2.1.1 DataFrame neu einlesen
MovieLenseToCut <- as(MovieLense, "data.frame")
MovieLenseToCut2.1.2 Auswahl der 400 Kunden
select_user_400 <- function(movie_df, start, end) {
selected_user <- movie_df %>%
group_by(user) %>%
summarize(Anzahl = n()) %>%
arrange(desc(Anzahl)) %>%
slice(start:end)
selected_user
}
MovieLense400User_1 <- select_user_400(MovieLenseToCut, 0, 400)
MovieLense400User_1MovieLense400User_2 <- select_user_400(MovieLenseToCut, 200, 599)
MovieLense400User_2Bei der Auswahl der 400 User haben wir direkt auch zwei Dataframes erstellt, da wir die MC zu zweit bearbeiten. Für Person 1 haben wir die 400 User mit den meisten Ratings ausgewählt und für Person 2 User 200 bis 600. Wir haben dieses Vorgehen gewählt um sicherzustellen, dass nur eine Teil der User in beiden Dataframes enthalten ist. Alternativ hätten wir von den Top 500 User zufällig 80% für Person 1 und 2 verwendet, dann hätte die Überlappung aber sehr hoch sein können, so ist es nur die Hälft.
2.1.3 Auswahl der 700 Movies
select_item_700 <- function(movie_df, start, end) {
selected_item <- MovieLenseToCut %>%
group_by(item) %>%
summarise(Anzahl = n()) %>%
arrange(desc(Anzahl)) %>%
slice(start:end)
}
MovieLense700Items_1 <- select_item_700(MovieLenseToCut, 0, 700)
MovieLense700Items_1MovieLense700Items_2 <- select_item_700(MovieLenseToCut, 150, 849)
MovieLense700Items_2Das gleiche Vorgehen haben wir bei den Filmen gewählt.
2.1.4 DataFrame schneiden
df_cutter <- function(movie_df, selected_user, selected_items) {
movie_df_cut <- movie_df %>%
filter(user %in% c(selected_user$user))
movie_df_cut <- movie_df_cut %>%
filter(item %in% c(selected_items$item))
movie_df_cut
}
MovieLenseCut_1 <- df_cutter(MovieLenseToCut, MovieLense400User_1, MovieLense700Items_1)
MovieLenseCut_1MovieLenseCut_2 <- df_cutter(MovieLenseToCut, MovieLense400User_2, MovieLense700Items_2)
MovieLenseCut_2Untersuche und dokumentiere die Eigenschaften des reduzierten Datensatzes und beschreibe den Effekt der Datenreduktion, d.h.
2.2 Anzahl Filme und Kunden sowie Sparsity vor und nach Datenreduktion,
2.2.1 Vor der Datenreduktion
image(MovieLense,
xlab = "Items",
ylab = "Users",
main = "Vor Datenreduktion, User-Item Matrix 943 x 1664") 
sparsity_text <- function(realrating_matrix) {
print(paste("Anzahl vorhandene User-Item Rating in", nratings(realrating_matrix) / (dim(realrating_matrix)[1] * dim(realrating_matrix)[2]) * 100, "%"))
print(paste("Sparsity der Matrix", 100 - (nratings(realrating_matrix) / (dim(realrating_matrix)[1] * dim(realrating_matrix)[2]) * 100), "%"))
}
sparsity_text(MovieLense)## [1] "Anzahl vorhandene User-Item Rating in 6.33412186964679 %"
## [1] "Sparsity der Matrix 93.6658781303532 %"Zur Repetition stellen wir nochmals die Sparsity als Bild dar und berechnen den Wert.
2.2.2 Nach der 1. Datenreduktion
MovieLenseCompact_1 <- as(MovieLenseCut_1, "realRatingMatrix")
image(MovieLenseCompact_1,
xlab = "Items",
ylab = "Users",
main = "Nach Datenreduktion 1, User-Item Matrix 400 x 700")
sparsity_text(MovieLenseCompact_1)## [1] "Anzahl vorhandene User-Item Rating in 24.0810714285714 %"
## [1] "Sparsity der Matrix 75.9189285714286 %"Für den ersten Datensatz wird ersichtlich, dass die Ratings gegenüber dem ursprünglichen Datensatz gleichmässig verteilt sind. Vereinzelt sind für User (z.B. im Bereich 90-150) und Items (z.B Bereicht um 600) dunklere Bereiche erkennbar. In diesen dürften die Ratings höher und Sparsity geringer sein. Die Sparsity beträgt nun auch nur noch etwa 75% und für 25% der möglichen Kombinationen zwischen User und Item wurden Ratings angegeben.
Diese starke Änderung war aber zu erwarten, da wir die User und Items mit den meisten Ratings ausgewählt haben.
2.2.3 Nach der 2. Datenreduktion
MovieLenseCompact_2 <- as(MovieLenseCut_2, "realRatingMatrix")
image(MovieLenseCompact_2,
xlab = "Items",
ylab = "Users",
main = "Nach Datenreduktion 2, User-Item Matrix 400 x 700")
sparsity_text(MovieLenseCompact_2)## [1] "Anzahl vorhandene User-Item Rating in 6.35142857142857 %"
## [1] "Sparsity der Matrix 93.6485714285714 %"Für den zweiten Datensatz wird ersichtlich, dass die Ratings gegenüber dem ursprünglichen Datensatz gleichmässig verteilt sind, gegenüber dem ersten Datensatz aber sichtbar weniger Ratings vorhanden sind. Dunklere Bereich, wie bei Datensatz1 sind kaum mehr zu erkennen. Die Sparsity beträgt liegt nun bei 93.6%, sie ist gegenüber dem ersten Datensatz also deutlich angestiegen, liegt aber bereits im Bereich des ursprünglichen Wertes. Dieser Anstieg war zu erwarten, da wir nicht mehr die User und Items mit den meisten Ratings ausgewählt haben, sondern z.B. bei den Usern bei Top 200 angefangen haben.
2.3 Mittlere Kundenratings pro Film vor und nach Datenreduktion,
mean_rating_per_film_viz <- function(movie_df) {
movie_df %>%
group_by(item) %>%
summarize(mean_rating_per_film = mean(rating)) %>%
ggplot(aes(x = mean_rating_per_film)) +
geom_histogram(color = "black", fill = "lightblue", binwidth = 0.1) +
labs(x = "Ratings",
y = "Anzahl",
title = "Mittlere Kundenratings Verteilung",
subtitle = paste("Gesamte Anzahl Kundenratings:", dim(movie_df)[1])) +
geom_vline(xintercept = mean(movie_df$rating), color = "red", linetype = "dashed", size = 0.5)
}
# Vor reduktion
print(mean_rating_per_film_viz(MovieLenseEDA))
# nach 1. Redutkion
print(mean_rating_per_film_viz(MovieLenseCut_1))
# nach 2. Reduktion
print(mean_rating_per_film_viz(MovieLenseCut_2))
Die erste Visualisierung zeigt den bereits bekannten Plot mit den
mittleren Kundenratings für den gesamten Datensatz. Plot 2 und 3 zeigt
die selbe Auswertung für die beiden gekürzten Datensätze. In den
Visualisierungen erkennen wir, dass der Mittelwert der Kundenrating für
den ursprünglichen, sowie auch für die beiden reduzierten Datensätze,
nicht grossartig ändert. Die Mittelwerte befinden sich bei allen im
Bereich von 3.5. Was aber erkennbar wird, ist, dass bei der 1. Reduktion
die hohe Anzahl Rating bei den natürlichen/ganzzahligen Zahlen
weggefallen ist. Weiterhin sind bei allen Visualisierungen erkennbar,
dass die meisten Rating im Bereich von 3 bis 4 liegen.
2.4 Für Gruppen: Quantifiziere “Intersection over Union” der Ratings der unterschiedlich reduzierten Datensätze.
intersect_join <- inner_join(MovieLenseCut_1, MovieLenseCut_2, by = c("user", "item"))
intersect_joinunion_join <- full_join(MovieLenseCut_1, MovieLenseCut_2, by = c("user", "item"))
union_joinpaste("Eine Intersection over Union von", dim(intersect_join)[1] / dim(union_join)[1] * 100, "%, zwischen den beiden reduzierten Datensätzen")## [1] "Eine Intersection over Union von 15.5638434935919 %, zwischen den beiden reduzierten Datensätzen"Zur Beantwortung dieser Frage haben wir einerseits einen Datensatz mit Daten, die in beiden Datensätzen vorhanden sind erstellt und diesen mit der gesamten Anzahl Daten verglichen. Es zeigt sich, dass es eine Überschneidung von 15.6% zwischen den beiden reduzierten Datensätzen gibt. Dieser eher tiefe Wert überrascht, weil z.B. 50% der User übereinstimmen. Aber aufgrund der hohen Sparsity ist die Überschneidung der Daten viel tiefer.
3 Analyse Ähnlichkeitsmatrix
Aufgabe 3: Erzeuge einen IBCF Recommender und analysiere die Ähnlichkeitsmatrix des trainierten Modelles für den reduzierten Datensatz.
3.1 Zerlege den reduzierten MovieLense Datensatz in ein disjunktes Trainings-und Testdatenset im Verhältnis 4:1,
train_test_split <- function(movie_df, split = 0.8) {
n <- dim(movie_df)[1]
n_train <- round(n * split)
n_test <- n - n_train
training <- movie_df[1:n_train]
test <- movie_df[(n_train + 1):n]
return(list(training, test))
}
train_test_list_1 <- train_test_split(MovieLenseCompact_1)
training_1 <- train_test_list_1[[1]]
test_1 <- train_test_list_1[[2]]
training_1## 320 x 700 rating matrix of class 'realRatingMatrix' with 53971 ratings.test_1## 80 x 700 rating matrix of class 'realRatingMatrix' with 13456 ratings.train_test_list_2 <- train_test_split(MovieLenseCompact_2)
training_2 <- train_test_list_2[[1]]
test_2 <- train_test_list_2[[2]]
training_2## 320 x 700 rating matrix of class 'realRatingMatrix' with 14368 ratings.test_2## 80 x 700 rating matrix of class 'realRatingMatrix' with 3416 ratings.Beide reduzierten Datensätze wurden im Verhältnis 4:1, (4 Teile Training und 1 Teil Test) reduziert.
3.2 Trainiere ein IBCF Modell mit 30 Nachbarn und Cosine Similarity
ribcf_1 <- Recommender(training_1, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_1## Recommender of type 'IBCF' for 'realRatingMatrix'
## learned using 320 users.ribcf_2 <- Recommender(training_2, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_2## Recommender of type 'IBCF' for 'realRatingMatrix'
## learned using 320 users.Es wurden jeweils für beide reduzierten Datensaetze ein IBCF Modell mit 30 Nachbarn und der Cosine Similarity mittels der von Recommenderlab zur Verfügung gestellten Methode trainiert. Die Auswertung bestätigt, dass das Training mittels 320 Usern, resp. 80% der ursprünglichen 400, durchgeführt wurde.
3.3 Bestimme die Verteilung der Filme, welche bei IBCF für paarweise Ähnlichkeitsvergleiche verwendet werden
ribcf_sim_item_df <- function(ribcf) {
# model
ribcf_model <- getModel(ribcf)
# dataframe erstellen
ribcf_sim_df <- as.data.frame(colSums(ribcf_model$sim > 0))
# Item als neue Spalte hinzufuegen und Index entfernen
ribcf_sim_df_ <- cbind(item = rownames(ribcf_sim_df), ribcf_sim_df)
rownames(ribcf_sim_df_) <- NULL
# return df
ribcf_sim_df_
}
ribcf_sim_viz <- function(ribcf_sim_df_, n_reduc) {
ribcf_sim_df_ %>%
rename(Anzahl = 2) %>%
ggplot(aes(x = Anzahl)) +
geom_histogram(binwidth = 1) +
labs(title = "Verteilung der Ähnlichkeitsvergleiche",
x = "Anzahl Filme als Nachbar",
y = "Anzahl",
subtitle = paste("ribcf", n_reduc))
}
ribcf_sim_df_1 <- ribcf_sim_item_df(ribcf_1)
ribcf_sim_viz(ribcf_sim_df_1, 1)
ribcf_sim_df_2 <- ribcf_sim_item_df(ribcf_2)
ribcf_sim_viz(ribcf_sim_df_2, 2)
In beiden Histogrammen erkennen wir auf der X Achse die Anzahl Filme die
als Nachbar bei einem anderen Film vorkommen. Man erkennt im Plot, dass
es wenige Filme gibt, die häufig viele Nachbaren haben. Beide Plots
folgene einer ähnlichen Verteilung.
3.4 Bestimme die Filme, die am häufigsten in der Cosine-Ähnlichkeitsmatrix auftauchen und analysiere deren Vorkommen und Ratings im reduzierten Datensatz.
top_10_item_sim <- function(ribcf_sim_df_, n_reduc) {
result <- ribcf_sim_df_ %>%
rename(Anzahl = 2) %>%
arrange(desc(Anzahl)) %>%
top_n(10)
print(result)
result %>%
ggplot(aes(x = Anzahl, y = item)) +
# arrange desc
geom_col(alpha = 0.5, color = "black", fill = "limegreen") +
labs(title = "Top 10 Filme die am häufigsten in der Nachbarschaft andere Filme auftauchen",
x = "Anzahl Film als Nachbar",
y = "Filme",
subtitle = paste("ribcf", n_reduc))
}
top_10_item_sim(ribcf_sim_df_1, 1)## Selecting by Anzahl## item Anzahl
## 1 Kundun (1997) 157
## 2 Fallen (1998) 148
## 3 Mouse Hunt (1997) 138
## 4 Sweet Hereafter, The (1997) 138
## 5 Air Bud (1997) 132
## 6 Eve's Bayou (1997) 132
## 7 Apostle, The (1997) 128
## 8 Desperate Measures (1998) 128
## 9 Leave It to Beaver (1997) 124
## 10 Love Jones (1997) 123
top_10_item_sim(ribcf_sim_df_2, 2)## Selecting by Anzahl## item Anzahl
## 1 When a Man Loves a Woman (1994) 151
## 2 Wings of the Dove, The (1997) 129
## 3 Virtuosity (1995) 128
## 4 Wyatt Earp (1994) 127
## 5 Trees Lounge (1996) 125
## 6 Unforgettable (1996) 125
## 7 Shallow Grave (1994) 123
## 8 Swimming with Sharks (1995) 121
## 9 What's Eating Gilbert Grape (1993) 121
## 10 Substitute, The (1996) 120
## 11 To Die For (1995) 120
## 12 Victor/Victoria (1982) 120
Für jeden der beiden Datensätze haben wir einen Dataframe und Plot mit den Filmen, die am häufigsten in der Cosine-Ähnlichkeitsmatrix auftauchen, erstellt. Bei den top 10 Filmen sind keine Gemeinsamkeiten ersichtlich. Die Anzahl der Vorkommen ist aber ähnlich, der höchste Wert ist zwischen 150 und 160 Vorkommen.
4 Implementierung Ähnlichkeitsmatrix
Aufgabe 4 (DIY): Implementiere eine Funktion zur effizienten Berechnung von sparsen Ähnlichkeitsmatrizen für IBCF RS und analysiere die Resultate für 100 zufällig gewählte Filme.
4.1 Implementiere eine Funktion, um (a) für ordinale Ratings effizient
die Cosine Similarity und (b) für binäre Ratings effizient die Jaccard Similarity zu berechnen,
number_user <- 100
number_item <- 100Diese Variablen haben wir für die Entwicklung der Funktionen verwendet. Wir konnte damit einfach kleinere, z.B. 5, Datensätze slicen.
4.1.1 Cosine Similarity
get_cossim_4 <- function(RatingMatrix, n_user, n_item){
sliced_matrix <- getRatingMatrix(RatingMatrix[1:n_user, 1:n_item])
sliced_matrix_t <- t(sliced_matrix)
temp_sim <- sliced_matrix_t / sqrt(rowSums(sliced_matrix_t ** 2))
cossim_matrix <- temp_sim %*% t(temp_sim)
cossim_matrix
}result_cossim_4 <- get_cossim_4(MovieLense, number_user, number_item)
result_cossim_4[1:20,1:20]## 20 x 20 sparse Matrix of class "dgCMatrix"## [[ unterdrücke 20 Spaltennamen 'Toy Story (1995)', 'GoldenEye (1995)', 'Four Rooms (1995)' ...]]##
## Toy Story (1995) 1.0000000 0.3786054
## GoldenEye (1995) 0.3786054 1.0000000
## Four Rooms (1995) 0.3557149 0.1595558
## Get Shorty (1995) 0.4085792 0.4058678
## Copycat (1995) 0.3540652 0.3398193
## Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.2106625 0.1078328
## Twelve Monkeys (1995) 0.6507823 0.2498391
## Babe (1995) 0.5128509 0.2921164
## Dead Man Walking (1995) 0.4809693 0.2701317
## Richard III (1995) 0.2412952 0.1873510
## Seven (Se7en) (1995) 0.4553382 0.1632439
## Usual Suspects, The (1995) 0.4651021 0.3486586
## Mighty Aphrodite (1995) 0.5220124 0.2496832
## Postino, Il (1994) 0.4588155 0.1724141
## Mr. Holland's Opus (1995) 0.6120818 0.2968567
## French Twist (Gazon maudit) (1995) 0.2202742 0.2062550
## From Dusk Till Dawn (1996) 0.3199297 0.3785939
## White Balloon, The (1995) 0.1396962 0.1479453
## Antonia's Line (1995) 0.2946435 0.1047364
## Angels and Insects (1995) 0.1891240 0.1290770
##
## Toy Story (1995) 0.3557149 0.4085792
## GoldenEye (1995) 0.1595558 0.4058678
## Four Rooms (1995) 1.0000000 0.3989039
## Get Shorty (1995) 0.3989039 1.0000000
## Copycat (1995) 0.2285752 0.2674599
## Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.2263010 0.1328422
## Twelve Monkeys (1995) 0.3581228 0.4245295
## Babe (1995) 0.2310704 0.5445979
## Dead Man Walking (1995) 0.2649610 0.4781120
## Richard III (1995) 0.3780578 0.2820925
## Seven (Se7en) (1995) 0.3843138 0.5195206
## Usual Suspects, The (1995) 0.3794973 0.6074053
## Mighty Aphrodite (1995) 0.3871603 0.3777443
## Postino, Il (1994) 0.4344255 0.2698077
## Mr. Holland's Opus (1995) 0.3117847 0.3590970
## French Twist (Gazon maudit) (1995) 0.3329636 0.2625611
## From Dusk Till Dawn (1996) 0.2558409 0.3633585
## White Balloon, The (1995) 0.4776651 0.2126344
## Antonia's Line (1995) 0.1690792 0.1032222
## Angels and Insects (1995) 0.4427924 0.1855159
##
## Toy Story (1995) 0.35406521 0.2106625
## GoldenEye (1995) 0.33981928 0.1078328
## Four Rooms (1995) 0.22857516 0.2263010
## Get Shorty (1995) 0.26745994 0.1328422
## Copycat (1995) 1.00000000 0.1313064
## Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.13130643 1.0000000
## Twelve Monkeys (1995) 0.33220032 0.2130495
## Babe (1995) 0.20393810 0.1805984
## Dead Man Walking (1995) 0.41637401 0.2092867
## Richard III (1995) 0.07604487 0.4311379
## Seven (Se7en) (1995) 0.36995125 0.1093345
## Usual Suspects, The (1995) 0.39453741 0.2776088
## Mighty Aphrodite (1995) 0.19202253 0.3006045
## Postino, Il (1994) 0.15320397 0.4191717
## Mr. Holland's Opus (1995) 0.39631951 0.1791067
## French Twist (Gazon maudit) (1995) 0.25115377 0.3187884
## From Dusk Till Dawn (1996) 0.32163376 0.2531139
## White Balloon, The (1995) 0.18015094 0.3658636
## Antonia's Line (1995) 0.12753608 0.4662172
## Angels and Insects (1995) 0.15717527 0.4488792
##
## Toy Story (1995) 0.6507823 0.5128509
## GoldenEye (1995) 0.2498391 0.2921164
## Four Rooms (1995) 0.3581228 0.2310704
## Get Shorty (1995) 0.4245295 0.5445979
## Copycat (1995) 0.3322003 0.2039381
## Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.2130495 0.1805984
## Twelve Monkeys (1995) 1.0000000 0.5179884
## Babe (1995) 0.5179884 1.0000000
## Dead Man Walking (1995) 0.5991567 0.6064674
## Richard III (1995) 0.2699059 0.3242348
## Seven (Se7en) (1995) 0.5694625 0.5399670
## Usual Suspects, The (1995) 0.5844860 0.5715472
## Mighty Aphrodite (1995) 0.5160271 0.4357768
## Postino, Il (1994) 0.3159025 0.4495279
## Mr. Holland's Opus (1995) 0.5034813 0.3576072
## French Twist (Gazon maudit) (1995) 0.1833778 0.0345436
## From Dusk Till Dawn (1996) 0.2413614 0.2963905
## White Balloon, The (1995) 0.2192261 0.1176950
## Antonia's Line (1995) 0.3078112 0.2350530
## Angels and Insects (1995) 0.1593891 0.2594140
##
## Toy Story (1995) 0.4809693 0.24129522
## GoldenEye (1995) 0.2701317 0.18735098
## Four Rooms (1995) 0.2649610 0.37805783
## Get Shorty (1995) 0.4781120 0.28209250
## Copycat (1995) 0.4163740 0.07604487
## Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.2092867 0.43113793
## Twelve Monkeys (1995) 0.5991567 0.26990593
## Babe (1995) 0.6064674 0.32423475
## Dead Man Walking (1995) 1.0000000 0.32750209
## Richard III (1995) 0.3275021 1.00000000
## Seven (Se7en) (1995) 0.5360525 0.35313083
## Usual Suspects, The (1995) 0.6633322 0.36883567
## Mighty Aphrodite (1995) 0.4985081 0.37249460
## Postino, Il (1994) 0.4480904 0.41711226
## Mr. Holland's Opus (1995) 0.5884584 0.15046955
## French Twist (Gazon maudit) (1995) 0.2486767 0.18462325
## From Dusk Till Dawn (1996) 0.3417637 0.39405520
## White Balloon, The (1995) 0.3480472 0.47453738
## Antonia's Line (1995) 0.2710362 0.38125745
## Angels and Insects (1995) 0.3226374 0.42364525
##
## Toy Story (1995) 0.45533821 0.4651021
## GoldenEye (1995) 0.16324390 0.3486586
## Four Rooms (1995) 0.38431384 0.3794973
## Get Shorty (1995) 0.51952065 0.6074053
## Copycat (1995) 0.36995125 0.3945374
## Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.10933445 0.2776088
## Twelve Monkeys (1995) 0.56946246 0.5844860
## Babe (1995) 0.53996700 0.5715472
## Dead Man Walking (1995) 0.53605254 0.6633322
## Richard III (1995) 0.35313083 0.3688357
## Seven (Se7en) (1995) 1.00000000 0.6427527
## Usual Suspects, The (1995) 0.64275270 1.0000000
## Mighty Aphrodite (1995) 0.25623511 0.4417965
## Postino, Il (1994) 0.23169366 0.3831814
## Mr. Holland's Opus (1995) 0.31591479 0.4257209
## French Twist (Gazon maudit) (1995) 0.20912731 0.2811128
## From Dusk Till Dawn (1996) 0.33991729 0.3440000
## White Balloon, The (1995) 0.28847237 0.3920784
## Antonia's Line (1995) 0.08985732 0.3045318
## Angels and Insects (1995) 0.18246935 0.2980934
##
## Toy Story (1995) 0.5220124 0.4588155
## GoldenEye (1995) 0.2496832 0.1724141
## Four Rooms (1995) 0.3871603 0.4344255
## Get Shorty (1995) 0.3777443 0.2698077
## Copycat (1995) 0.1920225 0.1532040
## Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.3006045 0.4191717
## Twelve Monkeys (1995) 0.5160271 0.3159025
## Babe (1995) 0.4357768 0.4495279
## Dead Man Walking (1995) 0.4985081 0.4480904
## Richard III (1995) 0.3724946 0.4171123
## Seven (Se7en) (1995) 0.2562351 0.2316937
## Usual Suspects, The (1995) 0.4417965 0.3831814
## Mighty Aphrodite (1995) 1.0000000 0.5845588
## Postino, Il (1994) 0.5845588 1.0000000
## Mr. Holland's Opus (1995) 0.4709003 0.4880400
## French Twist (Gazon maudit) (1995) 0.2874876 0.2066398
## From Dusk Till Dawn (1996) 0.1293548 0.2381653
## White Balloon, The (1995) 0.3692327 0.5039526
## Antonia's Line (1995) 0.5365988 0.4952783
## Angels and Insects (1995) 0.3282205 0.5172714
##
## Toy Story (1995) 0.6120818 0.2202742
## GoldenEye (1995) 0.2968567 0.2062550
## Four Rooms (1995) 0.3117847 0.3329636
## Get Shorty (1995) 0.3590970 0.2625611
## Copycat (1995) 0.3963195 0.2511538
## Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.1791067 0.3187884
## Twelve Monkeys (1995) 0.5034813 0.1833778
## Babe (1995) 0.3576072 0.0345436
## Dead Man Walking (1995) 0.5884584 0.2486767
## Richard III (1995) 0.1504695 0.1846233
## Seven (Se7en) (1995) 0.3159148 0.2091273
## Usual Suspects, The (1995) 0.4257209 0.2811128
## Mighty Aphrodite (1995) 0.4709003 0.2874876
## Postino, Il (1994) 0.4880400 0.2066398
## Mr. Holland's Opus (1995) 1.0000000 0.1586031
## French Twist (Gazon maudit) (1995) 0.1586031 1.0000000
## From Dusk Till Dawn (1996) 0.1868622 0.2342606
## White Balloon, The (1995) 0.3185419 0.4373740
## Antonia's Line (1995) 0.3028259 0.3096346
## Angels and Insects (1995) 0.2431769 0.3815932
##
## Toy Story (1995) 0.3199297 0.1396962
## GoldenEye (1995) 0.3785939 0.1479453
## Four Rooms (1995) 0.2558409 0.4776651
## Get Shorty (1995) 0.3633585 0.2126344
## Copycat (1995) 0.3216338 0.1801509
## Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.2531139 0.3658636
## Twelve Monkeys (1995) 0.2413614 0.2192261
## Babe (1995) 0.2963905 0.1176950
## Dead Man Walking (1995) 0.3417637 0.3480472
## Richard III (1995) 0.3940552 0.4745374
## Seven (Se7en) (1995) 0.3399173 0.2884724
## Usual Suspects, The (1995) 0.3440000 0.3920784
## Mighty Aphrodite (1995) 0.1293548 0.3692327
## Postino, Il (1994) 0.2381653 0.5039526
## Mr. Holland's Opus (1995) 0.1868622 0.3185419
## French Twist (Gazon maudit) (1995) 0.2342606 0.4373740
## From Dusk Till Dawn (1996) 1.0000000 0.3360672
## White Balloon, The (1995) 0.3360672 1.0000000
## Antonia's Line (1995) 0.2141239 0.4886175
## Angels and Insects (1995) 0.3420744 0.5303215
##
## Toy Story (1995) 0.29464348 0.1891240
## GoldenEye (1995) 0.10473645 0.1290770
## Four Rooms (1995) 0.16907917 0.4427924
## Get Shorty (1995) 0.10322223 0.1855159
## Copycat (1995) 0.12753608 0.1571753
## Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 0.46621721 0.4488792
## Twelve Monkeys (1995) 0.30781124 0.1593891
## Babe (1995) 0.23505300 0.2594140
## Dead Man Walking (1995) 0.27103623 0.3226374
## Richard III (1995) 0.38125745 0.4236452
## Seven (Se7en) (1995) 0.08985732 0.1824693
## Usual Suspects, The (1995) 0.30453181 0.2980934
## Mighty Aphrodite (1995) 0.53659876 0.3282205
## Postino, Il (1994) 0.49527834 0.5172714
## Mr. Holland's Opus (1995) 0.30282587 0.2431769
## French Twist (Gazon maudit) (1995) 0.30963462 0.3815932
## From Dusk Till Dawn (1996) 0.21412393 0.3420744
## White Balloon, The (1995) 0.48861751 0.5303215
## Antonia's Line (1995) 1.00000000 0.3100373
## Angels and Insects (1995) 0.31003735 1.0000000Mit der erstellten Funktion haben wir für den gesamten MovieLense Datensatz die Cosine Similarity Matrix berechnet. Um das Resultat lesbar darzustellen, zeigen wir hier nur die ersten fünf Item. Bei der Analyse der ersten 20 Items wurde ersichtlich, dass die Werte zwischen 0 und 1 liegen. Negative Similarities sind nicht ersichtlich. Wie mit dir besprochen und hergeleitet, ist das aber verständlich, da aufgrund der nicht-negativen Ratings der maximale Winkel 90° beträgt. Hätten wir mit normierten Ratings gearbeitet, wären auch negative Werte aufgetreten.
4.1.2 Jaccard Similarity
get_jaccardsim_4 <- function(RatingMatrix, n_user, n_item){
sliced_matrix_bin <- as(binarize(RatingMatrix[1:n_user, 1:n_item], minRating=4), "matrix")
sliced_matrix_bin_t <- t(sliced_matrix_bin)
matrix_corssprod <- tcrossprod(sliced_matrix_bin_t)
im <- which(matrix_corssprod > 0, arr.ind=TRUE)
b <- rowSums(sliced_matrix_bin_t)
Aim <- matrix_corssprod[im]
J = sparseMatrix(
i = im[,1],
j = im[,2],
x = Aim / (b[im[,1]] + b[im[,2]] - Aim),
dims = dim(matrix_corssprod)
)
J <- data.matrix(J)
J
}jaccardsim_4 <- get_jaccardsim_4(MovieLense, number_user, number_item)
jaccardsim_4[1:5, 1:5]## [,1] [,2] [,3] [,4] [,5]
## [1,] 1.00000000 0.05128205 0.05128205 0.1304348 0.1052632
## [2,] 0.05128205 1.00000000 0.00000000 0.0625000 0.0000000
## [3,] 0.05128205 0.00000000 1.00000000 0.0625000 0.0000000
## [4,] 0.13043478 0.06250000 0.06250000 1.0000000 0.1250000
## [5,] 0.10526316 0.00000000 0.00000000 0.1250000 1.0000000Bei der Jaccard Similarity sind wiederum nur positive Werte ersichtlich. Eine Auswertung dieser geplotteten Werte ergibt, dass sehr wenige Werte über 0.3 liegen. Die Ähnlichkeit dieser ersten 10 Filme gegenüber den ersten 100 anderen Items ist also eher gering.
4.2 Vergleiche deine Implementierung der Cosine-basierten
Ähnlichkeitsmatrix für ordinale Ratings mit der via recommenderlab und einem anderen R-Paket erzeugten Ähnlichkeitsmatrix,
4.2.1 Vergleich Cosine Similiarty mit Recommenderlab
#recom_simcosin_4 <- as.matrix(similarity(normalize(MovieLense[1:number_user, 1:number_item]), which = "items", method = "cosine"))
recom_simcosin_4 <- as.matrix(similarity(MovieLense[1:number_user, 1:number_item], which = "items", method = "cosine"))
recom_simcosin_4[1:5,1:5]## Toy Story (1995) GoldenEye (1995) Four Rooms (1995)
## Toy Story (1995) NA 0.9821980 0.9308431
## GoldenEye (1995) 0.9821980 NA 0.9455211
## Four Rooms (1995) 0.9308431 0.9455211 NA
## Get Shorty (1995) 0.9664688 0.9598695 0.9687050
## Copycat (1995) 0.9730499 0.9629100 0.9472136
## Get Shorty (1995) Copycat (1995)
## Toy Story (1995) 0.9664688 0.9730499
## GoldenEye (1995) 0.9598695 0.9629100
## Four Rooms (1995) 0.9687050 0.9472136
## Get Shorty (1995) NA 0.9368489
## Copycat (1995) 0.9368489 NAresult_cossim_4_scaled <- 1 / 2 * (result_cossim_4 + 1)
result_cossim_4_scaled[1:5,1:5]## 5 x 5 Matrix of class "dgeMatrix"
## Toy Story (1995) GoldenEye (1995) Four Rooms (1995)
## Toy Story (1995) 1.0000000 0.6893027 0.6778574
## GoldenEye (1995) 0.6893027 1.0000000 0.5797779
## Four Rooms (1995) 0.6778574 0.5797779 1.0000000
## Get Shorty (1995) 0.7042896 0.7029339 0.6994520
## Copycat (1995) 0.6770326 0.6699096 0.6142876
## Get Shorty (1995) Copycat (1995)
## Toy Story (1995) 0.7042896 0.6770326
## GoldenEye (1995) 0.7029339 0.6699096
## Four Rooms (1995) 0.6994520 0.6142876
## Get Shorty (1995) 1.0000000 0.6337300
## Copycat (1995) 0.6337300 1.0000000Für den Vergleich unserer Implementation mit der von Recommenderlab haben wir festgestellt, dass Recommenderlab die Resultate auf Werte zwischen 0 und 1 normiert. Wir haben diese Normierung auch auf unser Resultat durchgeführt. Oben ist das Resultat von Recommenderlab für die ersten fünf Filme ersichtlich, darunter unsere, normierte Implementation. Es lässt sich feststellen, dass die Werte von Recommenderlab sehr hoch, in der Nähe von 1 liegen. Unsere hingegen reichen etwa von 0.5 bis 1. Wir konnten die Ursache der Differenz nicht feststellen, es wäre aber ein Zufall, wenn die Ähnlichkeiten wirklich so hoch wären. Unsere Bandbreite, von 0.5 (resp. unnormiert 0) bis 1 ist deshalb realistischer.
4.2.2 Vergleich Cosine Similiarity mit anderem R-Paket
library(lsa)## Lade nötiges Paket: SnowballCrec_simMat <- similarity(MovieLenseCompact_1[,1:5], which = "items")
rec_simMat## 101 Dalmatians (1996) 12 Angry Men (1957)
## 12 Angry Men (1957) 0.9491014
## 187 (1997) 0.9377585 0.9951661
## 2 Days in the Valley (1996) 0.9424520 0.9908561
## 20,000 Leagues Under the Sea (1954) 0.9636541 0.9846314
## 187 (1997) 2 Days in the Valley (1996)
## 12 Angry Men (1957)
## 187 (1997)
## 2 Days in the Valley (1996) 0.9728694
## 20,000 Leagues Under the Sea (1954) 0.9824506 0.9745629result_cossim_4_scaled[1:5,1:5]## 5 x 5 Matrix of class "dgeMatrix"
## Toy Story (1995) GoldenEye (1995) Four Rooms (1995)
## Toy Story (1995) 1.0000000 0.6893027 0.6778574
## GoldenEye (1995) 0.6893027 1.0000000 0.5797779
## Four Rooms (1995) 0.6778574 0.5797779 1.0000000
## Get Shorty (1995) 0.7042896 0.7029339 0.6994520
## Copycat (1995) 0.6770326 0.6699096 0.6142876
## Get Shorty (1995) Copycat (1995)
## Toy Story (1995) 0.7042896 0.6770326
## GoldenEye (1995) 0.7029339 0.6699096
## Four Rooms (1995) 0.6994520 0.6142876
## Get Shorty (1995) 1.0000000 0.6337300
## Copycat (1995) 0.6337300 1.0000000Wir konnten keinen direkten Vergleich mit der Implementation von LSA machen, weil sie die Items anders sortieren und wir deshalb keine Übereinstimmende Items erhalten haben. Auch wenn wir die ersten 10 Items angezeigt haben, konnten wir keine Übereinstimmung von Items finden. Was aber auffällt ist, dass LSA auch sehr hohe Similarities, im Bereich von 1, berechnet hat.
4.3 Vergleiche deine mittels Cosine Similarity erzeugten Ähnlichkeitsmatrix für ordinale Ratings mit der Jaccard-basierten Ähnlichkeitsmatrix für binäre Ratings.
print("Cosine Similarity")## [1] "Cosine Similarity"result_cossim_4[1:5,1:5]## 5 x 5 sparse Matrix of class "dgCMatrix"
## Toy Story (1995) GoldenEye (1995) Four Rooms (1995)
## Toy Story (1995) 1.0000000 0.3786054 0.3557149
## GoldenEye (1995) 0.3786054 1.0000000 0.1595558
## Four Rooms (1995) 0.3557149 0.1595558 1.0000000
## Get Shorty (1995) 0.4085792 0.4058678 0.3989039
## Copycat (1995) 0.3540652 0.3398193 0.2285752
## Get Shorty (1995) Copycat (1995)
## Toy Story (1995) 0.4085792 0.3540652
## GoldenEye (1995) 0.4058678 0.3398193
## Four Rooms (1995) 0.3989039 0.2285752
## Get Shorty (1995) 1.0000000 0.2674599
## Copycat (1995) 0.2674599 1.0000000print("jaccard-basiert")## [1] "jaccard-basiert"jaccardsim_4[1:5, 1:5]## [,1] [,2] [,3] [,4] [,5]
## [1,] 1.00000000 0.05128205 0.05128205 0.1304348 0.1052632
## [2,] 0.05128205 1.00000000 0.00000000 0.0625000 0.0000000
## [3,] 0.05128205 0.00000000 1.00000000 0.0625000 0.0000000
## [4,] 0.13043478 0.06250000 0.06250000 1.0000000 0.1250000
## [5,] 0.10526316 0.00000000 0.00000000 0.1250000 1.0000000Zwischen Similarity basierend auf Cosine und Jaccard sind deutliche Unterschiede ersichtlich. Bei Cosine betragen die meisten Werte zwischen 0.15 und 0.40. Im Gegensatz betrage die meisten Werte bei Jaccard um oder den Wert Null. Das dürfte daran liegen, dass aufgrund der binären Codierung der Ratings, weniger Übereinstimmungen bestehen.
5 Analyse Top-N Listen - IBCF vs UBCF
Aufgabe 5: Vergleiche und diskutiere Top-N Empfehlungen von IBCF und UBCF Modellen mit 30 Nachbarn und Cosine Similarity für den reduzierten Datensatz. ## 5.1 Berechne Top-15 Empfehlungen für Testkunden mit IBCF und UBCF ### 5.1.1 ribcf & rubcf Modell trainieren
ribcf_1 <- Recommender(training_1, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_1## Recommender of type 'IBCF' for 'realRatingMatrix'
## learned using 320 users.rubcf_1 <- Recommender(training_1, "UBCF", param=list(nn= 30, method = "cosine"))
rubcf_1## Recommender of type 'UBCF' for 'realRatingMatrix'
## learned using 320 users.ribcf_2 <- Recommender(training_2, "IBCF", param=list(k= 30, method = "cosine"))
ribcf_2## Recommender of type 'IBCF' for 'realRatingMatrix'
## learned using 320 users.rubcf_2 <- Recommender(training_2, "UBCF", param=list(nn= 30, method = "cosine"))
rubcf_2## Recommender of type 'UBCF' for 'realRatingMatrix'
## learned using 320 users.Es wurden für beide reduzierten Datensätze jeweils ein ibcf und ubcf Recommender erstellt.
5.1.2 Model Predicitions erstellen
ribcftopNList_1 <- predict(ribcf_1, test_1, n=15)ribcftopNList_1## Recommendations as 'topNList' with n = 15 for 80 users.rubcftopNList_1 <- predict(rubcf_1, test_1, n=15)
rubcftopNList_1## Recommendations as 'topNList' with n = 15 for 80 users.ribcftopNList_2 <- predict(ribcf_2, test_2, n=15)
ribcftopNList_2## Recommendations as 'topNList' with n = 15 for 80 users.rubcftopNList_2 <- predict(rubcf_2, test_2, n=15)
rubcftopNList_2## Recommendations as 'topNList' with n = 15 for 80 users.Nun wurden für beide Datensätze Predictions mit n = 15 und für 80 User berechnet.
5.1.3 Ausgabe von einer Prediction
# ausgabe von einem output
as(ribcftopNList_1, "list")[1:5]## $`0`
## [1] "Strictly Ballroom (1992)"
## [2] "Like Water For Chocolate (Como agua para chocolate) (1992)"
## [3] "Casablanca (1942)"
## [4] "In the Company of Men (1997)"
## [5] "Love Bug, The (1969)"
## [6] "My Left Foot (1989)"
## [7] "African Queen, The (1951)"
## [8] "Fantasia (1940)"
## [9] "Fear (1996)"
## [10] "Sphere (1998)"
## [11] "Dial M for Murder (1954)"
## [12] "Dead Man Walking (1995)"
## [13] "Citizen Kane (1941)"
## [14] "Smoke (1995)"
## [15] "What's Eating Gilbert Grape (1993)"
##
## $`1`
## [1] "2 Days in the Valley (1996)"
## [2] "Adventures of Robin Hood, The (1938)"
## [3] "Alice in Wonderland (1951)"
## [4] "American in Paris, An (1951)"
## [5] "Being There (1979)"
## [6] "Bringing Up Baby (1938)"
## [7] "Cinema Paradiso (1988)"
## [8] "Crash (1996)"
## [9] "Dead Man Walking (1995)"
## [10] "Ed Wood (1994)"
## [11] "Grand Day Out, A (1992)"
## [12] "Hunt for Red October, The (1990)"
## [13] "Jackie Chan's First Strike (1996)"
## [14] "Jungle Book, The (1994)"
## [15] "Madness of King George, The (1994)"
##
## $`2`
## [1] "Time to Kill, A (1996)" "City Hall (1996)"
## [3] "City of Lost Children, The (1995)" "In the Company of Men (1997)"
## [5] "Independence Day (ID4) (1996)" "M*A*S*H (1970)"
## [7] "Forrest Gump (1994)" "Braveheart (1995)"
## [9] "Dave (1993)" "Dead Poets Society (1989)"
## [11] "Mr. Holland's Opus (1995)" "Cool Hand Luke (1967)"
## [13] "In the Line of Fire (1993)" "Ghost (1990)"
## [15] "Blade Runner (1982)"
##
## $`3`
## [1] "Bob Roberts (1992)"
## [2] "Clerks (1994)"
## [3] "Cool Hand Luke (1967)"
## [4] "Gandhi (1982)"
## [5] "His Girl Friday (1940)"
## [6] "Ice Storm, The (1997)"
## [7] "Pink Floyd - The Wall (1982)"
## [8] "Postino, Il (1994)"
## [9] "Rebel Without a Cause (1955)"
## [10] "Willy Wonka and the Chocolate Factory (1971)"
## [11] "Shine (1996)"
## [12] "Seven (Se7en) (1995)"
## [13] "Grosse Pointe Blank (1997)"
## [14] "Three Colors: Red (1994)"
## [15] "Boot, Das (1981)"
##
## $`4`
## [1] "Monty Python's Life of Brian (1979)" "Henry V (1989)"
## [3] "As Good As It Gets (1997)" "In the Company of Men (1997)"
## [5] "Junior (1994)" "Renaissance Man (1994)"
## [7] "Cinema Paradiso (1988)" "Dumbo (1941)"
## [9] "White Squall (1996)" "Boot, Das (1981)"
## [11] "Strictly Ballroom (1992)" "When Harry Met Sally... (1989)"
## [13] "Forbidden Planet (1956)" "Amadeus (1984)"
## [15] "American in Paris, An (1951)"Dies ist eine Übersicht der Empfehlungen für die ersten 5 User. Wie erfordert, wurden jeweils 15 Empfehlungen generiert. Auf den ersten Blick werden viele unterschiedlichen Filme empfohlen.
5.2 Vergleiche die Top-15 Empfehlungen und deren Verteilung und diskutiere Gemeinsamkeiten und Unterschiede zwischen IBCF und UBCF für alle Testkunden.
# df funktion erstellen
topN_df <- function(topNList){
counts <- table(unlist(as.array(as(topNList, "list"))))
df <- data.frame(Movie = names(counts), Count = unname(counts)) %>%
select("Movie", "Count.Freq") %>%
rename("Count" = "Count.Freq") %>%
arrange(desc(Count))
df
}
# alle dfs erstellen
ribcftopN_df_1 <- topN_df(ribcftopNList_1)
ribcftopN_df_1ribcftopN_df_2 <- topN_df(ribcftopNList_2)
ribcftopN_df_2rubcftopN_df_1 <- topN_df(rubcftopNList_1)
rubcftopN_df_1rubcftopN_df_2 <- topN_df(rubcftopNList_2)
rubcftopN_df_2Die ersten beiden Tabellen stellen die Empfehlungen und deren Anzahl basierend auf IBCF für die beiden Datensätze dar. In den Top 10 Empfehlungen sind sehr unterschiedliche Empfehlungen, es gibt kaum Überschneidungen. Für den ersten Datensatz wird ein Film maximal 11 mal, im zweiten maximal 15 mal empfohlen. Beim ersten Datensatz werden insgesamt 487 Filme und beim zweiten 407 empfohlen.
Die letzten beiden Tabellen stellen die Empfehlungen basierend auf UBCF für die beiden Datensätze dar. Die Top 10 Filme sind wieder sehr unterschiedlich. Grosse Unterschiede gibt es auch bei der Anzahl Vorkommen der Top Filme. Für den ersten Datensatz werden sie bis zu 30 mal empfohlen, während es beim zweiten maximal 14 mal war. Auch liegt die Anzahl Empfehlungen mit 301 vs 392 weit auseinander.
Für weitere Informationen visualisieren wir nun auch die Top Empfehlungen.
5.2.1 Verteilungen visualisieren
# funktion zur Visualisierung
top15_df_visualize <- function(topNList, subtitle){
topNList %>% head(15) %>%
ggplot(aes(x = reorder(Movie, Count), y = Count)) +
geom_bar(stat = "identity", fill = "limegreen", alpha = 0.5, color = "black") +
coord_flip() +
labs(x = "Movie",
y = "Anzahl",
title = "Top-15 Empfehlungen",
subtitle = subtitle)
}
grid.arrange(top15_df_visualize(ribcftopN_df_1, "ribcf 1"),
top15_df_visualize(rubcftopN_df_1, "rubcf 1"),
ncol = 2)
grid.arrange(top15_df_visualize(ribcftopN_df_2, "ribcf 2"),
top15_df_visualize(rubcftopN_df_2, "rubcf 2"),
ncol = 2)
Dank der library gridExtra können wir die beiden Datensätze
nebeneinander darstellen. Ersichtlich wird, wie schnell die Anzahl
Empfehlungen pro Film abnimmt. In der ersten Lasche, IBCF, sieht man,
dass die Anzahl linear abnimmt, nachdem die ersten fünf Filme gleich
häufig empfohlen werden. Hingegen nehmen die Anzahl im zweiten Datensatz
(Grafik rechts) zuerst schnell, bis etwa zum Niveau des ersten
Datensatzes, dann linear ab. Bei UBCF, in der zweiten Lasche, nimmt die
Anzahl bei beiden Datensätzen linear ab.
Die erwähnte Behauptung “Recommender Systeme machen für alle Nutzer die gleichen Empfehlungen” kann dank der Tabellen und Histogramme verworfen werden. Es werden viele unterschiedliche Filme empfohlen, vieleviele Filme werden nur wenigen Usern (<4) empfohlen.
6 Analyse Top-N Listen - Ratings
Aufgabe 6: Untersuche den Einfluss von Ratings (ordinale vs binäre Ratings) und Modelltyp (IBCF vs UBCF) auf Top-N Empfehlungen für den reduzierten Datensatz. Vergleiche den Anteil übereinstimmender Empfehlungen der Top-15 Liste für ## 6.1 IBCF vs UBCF, beide mit ordinalem Rating und Cosine Similarity für alle Testkunden,
compare_ibcf_ubcf <- function(ibcf, ubcf) {
print(paste("Anzahl IBCF:", nrow(ibcf)))
print(paste("Anzahl UBCF:", nrow(ubcf)))
IntersectordRatCosine <- intersect(ibcf$Movie, ubcf$Movie)
print(paste("Anzahl gemeinsame Empfehlungen:", length(IntersectordRatCosine)))
print(paste("Anteil IBCF:", length(IntersectordRatCosine) / nrow(ibcf) * 100))
print(paste("Anteil UBCF:", length(IntersectordRatCosine) / nrow(ubcf) * 100))
}
print("Erste Datenreduktion")## [1] "Erste Datenreduktion"compare_ibcf_ubcf(ribcftopN_df_1, rubcftopN_df_1)## [1] "Anzahl IBCF: 487"
## [1] "Anzahl UBCF: 301"
## [1] "Anzahl gemeinsame Empfehlungen: 231"
## [1] "Anteil IBCF: 47.4332648870637"
## [1] "Anteil UBCF: 76.7441860465116"print("Zweite Datenreduktion")## [1] "Zweite Datenreduktion"compare_ibcf_ubcf(ribcftopN_df_2, rubcftopN_df_2)## [1] "Anzahl IBCF: 407"
## [1] "Anzahl UBCF: 392"
## [1] "Anzahl gemeinsame Empfehlungen: 226"
## [1] "Anteil IBCF: 55.5282555282555"
## [1] "Anteil UBCF: 57.6530612244898"Erste Datenreduktion: Für IBCF werden 487 und UBCF 301 Filme empfohlen, dabei gibt es eine Übereinstimmung von 231 Filmen. Das entsprechen bei IBCF 47.5% und bei UBCF 76.7%. Zweite Datenreduktion: Für IBCF werden 407 und UBCF 392 Filme empfohlen, dabei gibt es eine Übereinstimmung von 226 Filmen. Das entsprechen bei IBCF 55% und bei UBCF 57%.
Insgesamt generieren also beide Methoden ähnliche Empfehlungen, rund die Hälfte bis 3/4 der Empfehlungen generiert auch die andere Methode. Auffällig ist hingegen beim ersten Datensatz, dass IBCF viel mehr Filme empfiehlt, während es beim zweiten etwa gleich viel sind.
Beim zweiten Datensatz ist auch der Anteil an Gemeinsamkeiten jeweils bei rund 55% und damit ausgeglichener als im ersten Datensatz. Ich kann mir vorstellen, dass das daran liegt, dass beim zweiten Datensatz die Sparsity der Matrix höher ist und damit mehr Spielraum offen ist.
6.2 IBCF vs UBCF, beide mit binärem Rating und Jaccard Similarity für alle Testkunden,
training_bin_1 <- binarize(training_1, minRating = 4)
test_bin_1 <- binarize(test_1, minRating = 4)
training_bin_2 <- binarize(training_2, minRating = 4)
test_bin_2 <- binarize(test_2, minRating = 4)
ribcf_bin_1 <- Recommender(training_bin_1, "IBCF", param=list(k= 30, method = "jaccard"))
ribcf_bin_1## Recommender of type 'IBCF' for 'binaryRatingMatrix'
## learned using 320 users.rubcf_bin_1 <- Recommender(training_bin_1, "UBCF", param=list(nn= 30, method = "jaccard"))
rubcf_bin_1## Recommender of type 'UBCF' for 'binaryRatingMatrix'
## learned using 320 users.ribcf_bin_2 <- Recommender(training_bin_2, "IBCF", param=list(k= 30, method = "jaccard"))
ribcf_bin_2## Recommender of type 'IBCF' for 'binaryRatingMatrix'
## learned using 320 users.rubcf_bin_2 <- Recommender(training_bin_2, "UBCF", param=list(nn= 30, method = "jaccard"))
rubcf_bin_2## Recommender of type 'UBCF' for 'binaryRatingMatrix'
## learned using 320 users.ribcftopNList_bin_1 = predict(ribcf_bin_1, test_bin_1, n=15)
ribcftopNList_bin_1## Recommendations as 'topNList' with n = 15 for 80 users.rubcftopNList_bin_1 = predict(rubcf_bin_1, test_bin_1, n=15)
rubcftopNList_bin_1## Recommendations as 'topNList' with n = 15 for 80 users.ribcftopNList_bin_2 = predict(ribcf_bin_2, test_bin_2, n=15)
ribcftopNList_bin_2## Recommendations as 'topNList' with n = 15 for 80 users.rubcftopNList_bin_2 = predict(rubcf_bin_2, test_bin_2, n=15)
rubcftopNList_bin_2## Recommendations as 'topNList' with n = 15 for 80 users.ribcftopN_df_bin_1 <- topN_df(ribcftopNList_bin_1)
ribcftopN_df_bin_1ribcftopN_df_bin_2 <- topN_df(ribcftopNList_bin_2)
ribcftopN_df_bin_2rubcftopN_df_bin_1 <- topN_df(rubcftopNList_bin_1)
rubcftopN_df_bin_1rubcftopN_df_bin_2 <- topN_df(rubcftopNList_bin_2)
rubcftopN_df_bin_2Diese Auswertung entspricht der, der vorherigen Aufgabe, nur dass dieses mal mit binären Ratings und Jaccard Similarity gearbeitet wurde. Es wird auch hier ersichtlich, dass die Empfehlungen sehr unterschiedlich sind. Bei IBCF (erste zwei Tabellen) werden für den ersten Datensatz die Top Filme sehr viel häufiger (39 mal vs 16 mal) empfohlen. Das gleiche Muster, wenn aber schwächer, ist bei den UBCF ersichtlich.
print("Erste Datenreduktion binaer")## [1] "Erste Datenreduktion binaer"compare_ibcf_ubcf(ribcftopN_df_bin_1, rubcftopN_df_bin_1)## [1] "Anzahl IBCF: 87"
## [1] "Anzahl UBCF: 447"
## [1] "Anzahl gemeinsame Empfehlungen: 6"
## [1] "Anteil IBCF: 6.89655172413793"
## [1] "Anteil UBCF: 1.34228187919463"print("Zweite Datenreduktion binaer")## [1] "Zweite Datenreduktion binaer"compare_ibcf_ubcf(ribcftopN_df_bin_2, rubcftopN_df_bin_2)## [1] "Anzahl IBCF: 411"
## [1] "Anzahl UBCF: 519"
## [1] "Anzahl gemeinsame Empfehlungen: 296"
## [1] "Anteil IBCF: 72.0194647201946"
## [1] "Anteil UBCF: 57.0327552986513"Im Gegensatz zur vorherigen Aufgabe und den zweiten Datensatz, gibt es für den ersten fast keine gemeinsame Empfehlungen. Es fällt auch auf, dass für IBCF nur 87 Filme empfohlen werden. Diese Auswertung wurde mit minRating 4 für die binäre Klassifizierung berechnet. Mit Rating 3 sieht dieser Sachverhalt ähnlich aus, bei minRating 5 ist die Übereinstimmung aber wieder im normalen Bereich. Wieso minRating 3 und 4 so tiefe Übereinstimmungen generiert haben, können wir nicht nachvollziehe. Dass minRating 5 aber bessere Resultate generiert, liegt daran, dass nun nur noch wenige Items als 1 klassifiziert werden und damit weniger Filme zur Empfehlung zur Verfügung stellen.
6.3 UBCF mit ordinalem (Cosine Similarity) vs UBCF mit binärem Rating (Jaccard Similarity) für alle Testkunden.
compare_ubcf <- function(ibcf, ubcf) {
print(paste("Anzahl UBCF ord:", nrow(ibcf)))
print(paste("Anzahl UBCF bin:", nrow(ubcf)))
IntersectordRatCosine <- intersect(ibcf$Movie, ubcf$Movie)
print(paste("Anzahl gemeinsame Empfehlungen:", length(IntersectordRatCosine)))
print(paste("Anteil UBCF ord:", length(IntersectordRatCosine) / nrow(ibcf) * 100))
print(paste("Anteil UBCF bin:", length(IntersectordRatCosine) / nrow(ubcf) * 100))
}Erstellung der Funktion und Berechnung des Resultats
print("Erste Datenreduktion")## [1] "Erste Datenreduktion"compare_ubcf(rubcftopN_df_1, rubcftopN_df_bin_1)## [1] "Anzahl UBCF ord: 301"
## [1] "Anzahl UBCF bin: 447"
## [1] "Anzahl gemeinsame Empfehlungen: 207"
## [1] "Anteil UBCF ord: 68.7707641196013"
## [1] "Anteil UBCF bin: 46.3087248322148"print("Zweite Datenreduktion")## [1] "Zweite Datenreduktion"compare_ubcf(rubcftopN_df_2, rubcftopN_df_bin_2)## [1] "Anzahl UBCF ord: 392"
## [1] "Anzahl UBCF bin: 519"
## [1] "Anzahl gemeinsame Empfehlungen: 301"
## [1] "Anteil UBCF ord: 76.7857142857143"
## [1] "Anteil UBCF bin: 57.9961464354528"Beim Vergleich von UBCF mit ordinalem und binärem Rating werden wieder mehr übereinstimmende Filme empfohlen. Für den ersten Datensatz werden 207 Filme bei beiden Modellen und beim zweiten Datensatz 301 übereinstimmende Filme empfohlen. Da bei beiden Datensätzen mit ordinalem Rating weniger Empfehlungen generiert werden, ist der Anteil Übereinstimmungen bei ordinalen Ratings entsprechend höher.
7 Analyse Top-N Listen - IBCF vs SVD
Aufgabe 7: Vergleiche Memory-based IBCF und Modell-based SVD Recommenders bezüglich Überschneidung ihrer Top-N Empfehlungen für die User-Item Matrix des reduzierten Datensatzes (Basis: reduzierter Datensatz, IBCF mit 30 Nachbarn und Cosine Similarity). Vergleiche wie sich der Anteil übereinstimmender Empfehlungen der Top-15 Liste für IBCF vs verschiedene SVD Modelle verändert, wenn die Anzahl der Singulärwerte für SVD von 10 auf 20, 30, 40, 50 verändert wird.
# Funktion fuer SVD Model
generate_SVD_topN_recomm <- function(train, test, svd_value = ksvd){
recom_model <- Recommender(train, "SVD", param=list(k= svd_value))
top_n_recom <- predict(recom_model, test, n=15)
top_n_recom
}
# Funktion fuer verschiedene N
generate_SVD_topN_lists <- function(train, test, N_values) {
rsvd_topN_lists <- list()
for (i in 1:length(N_values)) {
N <- N_values[i]
list_name <- paste0("rsvd", N, "topNList")
rsvd_topN_lists[[list_name]] <- generate_SVD_topN_recomm(train, test, N)
}
rsvd_topN_lists
}Funktion zur Berechnung des Resultats
N_values <- c(10, 20, 30, 40, 50)
rsvd_topN_lists_1 <- generate_SVD_topN_lists(training_1, test_1, N_values)
print("Erster Datensatz")## [1] "Erster Datensatz"rsvd_topN_lists_1## $rsvd10topNList
## Recommendations as 'topNList' with n = 15 for 80 users.
##
## $rsvd20topNList
## Recommendations as 'topNList' with n = 15 for 80 users.
##
## $rsvd30topNList
## Recommendations as 'topNList' with n = 15 for 80 users.
##
## $rsvd40topNList
## Recommendations as 'topNList' with n = 15 for 80 users.
##
## $rsvd50topNList
## Recommendations as 'topNList' with n = 15 for 80 users.rsvd_topN_lists_2 <- generate_SVD_topN_lists(training_2, test_2, N_values)
print("Zweiter Datensatz")## [1] "Zweiter Datensatz"rsvd_topN_lists_2## $rsvd10topNList
## Recommendations as 'topNList' with n = 15 for 80 users.
##
## $rsvd20topNList
## Recommendations as 'topNList' with n = 15 for 80 users.
##
## $rsvd30topNList
## Recommendations as 'topNList' with n = 15 for 80 users.
##
## $rsvd40topNList
## Recommendations as 'topNList' with n = 15 for 80 users.
##
## $rsvd50topNList
## Recommendations as 'topNList' with n = 15 for 80 users.generate_topN_dfs <- function(rsvd_topN_lists) {
topN_dfs <- list()
for (i in 1:length(rsvd_topN_lists)) {
list_name <- names(rsvd_topN_lists)[i]
df_name <- paste0(list_name, "_df")
topN_dfs[[df_name]] <- topN_df(rsvd_topN_lists[[i]])
}
topN_dfs
}
topN_df_svd_1 <- generate_topN_dfs(rsvd_topN_lists_1)
print("Erster Datensatz")## [1] "Erster Datensatz"topN_df_svd_1## $rsvd10topNList_df
## Movie
## 1 Wallace & Gromit: The Best of Aardman Animation (1996)
## 2 Close Shave, A (1995)
## 3 Some Folks Call It a Sling Blade (1993)
## 4 Wrong Trousers, The (1993)
## 5 Good Will Hunting (1997)
## 6 Waiting for Guffman (1996)
## 7 As Good As It Gets (1997)
## 8 Kundun (1997)
## 9 Rear Window (1954)
## 10 Shall We Dance? (1996)
## 11 Casablanca (1942)
## 12 12 Angry Men (1957)
## 13 Usual Suspects, The (1995)
## 14 Schindler's List (1993)
## 15 Shawshank Redemption, The (1994)
## 16 L.A. Confidential (1997)
## 17 Titanic (1997)
## 18 Citizen Kane (1941)
## 19 Godfather, The (1972)
## 20 Secrets & Lies (1996)
## 21 North by Northwest (1959)
## 22 One Flew Over the Cuckoo's Nest (1975)
## 23 Sling Blade (1996)
## 24 To Kill a Mockingbird (1962)
## 25 Silence of the Lambs, The (1991)
## 26 Vertigo (1958)
## 27 Maltese Falcon, The (1941)
## 28 Lawrence of Arabia (1962)
## 29 Princess Bride, The (1987)
## 30 Boot, Das (1981)
## 31 Braveheart (1995)
## 32 Godfather: Part II, The (1974)
## 33 Manchurian Candidate, The (1962)
## 34 Dr. Strangelove or: How I Learned to Stop Worrying and Love the Bomb (1963)
## 35 Chasing Amy (1997)
## 36 Terminator 2: Judgment Day (1991)
## 37 Apt Pupil (1998)
## 38 Empire Strikes Back, The (1980)
## 39 Fargo (1996)
## 40 Sweet Hereafter, The (1997)
## 41 Taxi Driver (1976)
## 42 African Queen, The (1951)
## 43 Bridge on the River Kwai, The (1957)
## 44 Chinatown (1974)
## 45 Henry V (1989)
## 46 It's a Wonderful Life (1946)
## 47 Persuasion (1995)
## 48 Cinema Paradiso (1988)
## 49 Great Escape, The (1963)
## 50 Hoop Dreams (1994)
## 51 Lone Star (1996)
## 52 Psycho (1960)
## 53 Pulp Fiction (1994)
## 54 Raging Bull (1980)
## 55 Clockwork Orange, A (1971)
## 56 Delicatessen (1991)
## 57 Grand Day Out, A (1992)
## 58 Leaving Las Vegas (1995)
## 59 Much Ado About Nothing (1993)
## 60 Raiders of the Lost Ark (1981)
## 61 Star Wars (1977)
## 62 Sunset Blvd. (1950)
## 63 2001: A Space Odyssey (1968)
## 64 Air Force One (1997)
## 65 Alien (1979)
## 66 Aliens (1986)
## 67 Amadeus (1984)
## 68 Clerks (1994)
## 69 Day the Earth Stood Still, The (1951)
## 70 Duck Soup (1933)
## 71 Forrest Gump (1994)
## 72 Gandhi (1982)
## 73 Glory (1989)
## 74 Graduate, The (1967)
## 75 Indiana Jones and the Last Crusade (1989)
## 76 Jean de Florette (1986)
## 77 Manon of the Spring (Manon des sources) (1986)
## 78 Monty Python and the Holy Grail (1974)
## 79 Raise the Red Lantern (1991)
## 80 Reservoir Dogs (1992)
## 81 Return of the Jedi (1983)
## 82 Rock, The (1996)
## 83 Sting, The (1973)
## 84 Third Man, The (1949)
## 85 Wizard of Oz, The (1939)
## 86 Young Frankenstein (1974)
## Count
## 1 75
## 2 70
## 3 69
## 4 63
## 5 59
## 6 56
## 7 52
## 8 52
## 9 47
## 10 44
## 11 42
## 12 41
## 13 35
## 14 33
## 15 32
## 16 30
## 17 30
## 18 26
## 19 19
## 20 19
## 21 18
## 22 17
## 23 17
## 24 17
## 25 15
## 26 14
## 27 13
## 28 11
## 29 11
## 30 10
## 31 10
## 32 10
## 33 10
## 34 9
## 35 8
## 36 6
## 37 5
## 38 5
## 39 5
## 40 5
## 41 5
## 42 4
## 43 4
## 44 4
## 45 4
## 46 4
## 47 4
## 48 3
## 49 3
## 50 3
## 51 3
## 52 3
## 53 3
## 54 3
## 55 2
## 56 2
## 57 2
## 58 2
## 59 2
## 60 2
## 61 2
## 62 2
## 63 1
## 64 1
## 65 1
## 66 1
## 67 1
## 68 1
## 69 1
## 70 1
## 71 1
## 72 1
## 73 1
## 74 1
## 75 1
## 76 1
## 77 1
## 78 1
## 79 1
## 80 1
## 81 1
## 82 1
## 83 1
## 84 1
## 85 1
## 86 1
##
## $rsvd20topNList_df
## Movie
## 1 Wallace & Gromit: The Best of Aardman Animation (1996)
## 2 Close Shave, A (1995)
## 3 Wrong Trousers, The (1993)
## 4 Some Folks Call It a Sling Blade (1993)
## 5 Good Will Hunting (1997)
## 6 Waiting for Guffman (1996)
## 7 As Good As It Gets (1997)
## 8 Rear Window (1954)
## 9 Kundun (1997)
## 10 Casablanca (1942)
## 11 Shall We Dance? (1996)
## 12 Usual Suspects, The (1995)
## 13 Shawshank Redemption, The (1994)
## 14 12 Angry Men (1957)
## 15 Schindler's List (1993)
## 16 Titanic (1997)
## 17 Citizen Kane (1941)
## 18 L.A. Confidential (1997)
## 19 Secrets & Lies (1996)
## 20 To Kill a Mockingbird (1962)
## 21 Godfather, The (1972)
## 22 North by Northwest (1959)
## 23 Vertigo (1958)
## 24 One Flew Over the Cuckoo's Nest (1975)
## 25 Sling Blade (1996)
## 26 Boot, Das (1981)
## 27 Dr. Strangelove or: How I Learned to Stop Worrying and Love the Bomb (1963)
## 28 Maltese Falcon, The (1941)
## 29 Silence of the Lambs, The (1991)
## 30 Godfather: Part II, The (1974)
## 31 Manchurian Candidate, The (1962)
## 32 It's a Wonderful Life (1946)
## 33 Apt Pupil (1998)
## 34 Bridge on the River Kwai, The (1957)
## 35 Lawrence of Arabia (1962)
## 36 Amadeus (1984)
## 37 Braveheart (1995)
## 38 Princess Bride, The (1987)
## 39 Fargo (1996)
## 40 Henry V (1989)
## 41 Hoop Dreams (1994)
## 42 Pulp Fiction (1994)
## 43 Sweet Hereafter, The (1997)
## 44 African Queen, The (1951)
## 45 Terminator 2: Judgment Day (1991)
## 46 Chasing Amy (1997)
## 47 Chinatown (1974)
## 48 Delicatessen (1991)
## 49 Empire Strikes Back, The (1980)
## 50 Grand Day Out, A (1992)
## 51 Lone Star (1996)
## 52 Persuasion (1995)
## 53 Psycho (1960)
## 54 Sunset Blvd. (1950)
## 55 Taxi Driver (1976)
## 56 Cinema Paradiso (1988)
## 57 Day the Earth Stood Still, The (1951)
## 58 Graduate, The (1967)
## 59 Great Escape, The (1963)
## 60 Raging Bull (1980)
## 61 Star Wars (1977)
## 62 Sting, The (1973)
## 63 Unforgiven (1992)
## 64 2001: A Space Odyssey (1968)
## 65 Air Force One (1997)
## 66 Contact (1997)
## 67 Forrest Gump (1994)
## 68 Glory (1989)
## 69 Reservoir Dogs (1992)
## 70 This Is Spinal Tap (1984)
## 71 Wizard of Oz, The (1939)
## 72 Alien (1979)
## 73 Apocalypse Now (1979)
## 74 Apollo 13 (1995)
## 75 Blade Runner (1982)
## 76 Blues Brothers, The (1980)
## 77 Butch Cassidy and the Sundance Kid (1969)
## 78 Christmas Carol, A (1938)
## 79 Clerks (1994)
## 80 Clockwork Orange, A (1971)
## 81 Dead Man Walking (1995)
## 82 Dead Poets Society (1989)
## 83 Fantasia (1940)
## 84 Gandhi (1982)
## 85 Monty Python and the Holy Grail (1974)
## 86 Much Ado About Nothing (1993)
## 87 Patton (1970)
## 88 Raiders of the Lost Ark (1981)
## 89 Raise the Red Lantern (1991)
## 90 Return of the Jedi (1983)
## 91 Right Stuff, The (1983)
## 92 Rock, The (1996)
## 93 Sense and Sensibility (1995)
## 94 Strictly Ballroom (1992)
## 95 Terminator, The (1984)
## 96 Third Man, The (1949)
## 97 Willy Wonka and the Chocolate Factory (1971)
## 98 Young Frankenstein (1974)
## Count
## 1 75
## 2 69
## 3 63
## 4 60
## 5 57
## 6 56
## 7 46
## 8 44
## 9 43
## 10 42
## 11 39
## 12 33
## 13 30
## 14 29
## 15 29
## 16 29
## 17 27
## 18 27
## 19 22
## 20 19
## 21 18
## 22 18
## 23 18
## 24 17
## 25 16
## 26 13
## 27 13
## 28 13
## 29 12
## 30 11
## 31 11
## 32 9
## 33 8
## 34 8
## 35 8
## 36 7
## 37 7
## 38 7
## 39 6
## 40 6
## 41 6
## 42 6
## 43 6
## 44 5
## 45 5
## 46 4
## 47 4
## 48 4
## 49 4
## 50 4
## 51 4
## 52 4
## 53 4
## 54 4
## 55 4
## 56 3
## 57 3
## 58 3
## 59 3
## 60 3
## 61 3
## 62 3
## 63 3
## 64 2
## 65 2
## 66 2
## 67 2
## 68 2
## 69 2
## 70 2
## 71 2
## 72 1
## 73 1
## 74 1
## 75 1
## 76 1
## 77 1
## 78 1
## 79 1
## 80 1
## 81 1
## 82 1
## 83 1
## 84 1
## 85 1
## 86 1
## 87 1
## 88 1
## 89 1
## 90 1
## 91 1
## 92 1
## 93 1
## 94 1
## 95 1
## 96 1
## 97 1
## 98 1
##
## $rsvd30topNList_df
## Movie
## 1 Wallace & Gromit: The Best of Aardman Animation (1996)
## 2 Close Shave, A (1995)
## 3 Wrong Trousers, The (1993)
## 4 Some Folks Call It a Sling Blade (1993)
## 5 Good Will Hunting (1997)
## 6 Waiting for Guffman (1996)
## 7 As Good As It Gets (1997)
## 8 Rear Window (1954)
## 9 Casablanca (1942)
## 10 Shall We Dance? (1996)
## 11 Kundun (1997)
## 12 12 Angry Men (1957)
## 13 Titanic (1997)
## 14 Usual Suspects, The (1995)
## 15 Shawshank Redemption, The (1994)
## 16 L.A. Confidential (1997)
## 17 Schindler's List (1993)
## 18 Secrets & Lies (1996)
## 19 To Kill a Mockingbird (1962)
## 20 One Flew Over the Cuckoo's Nest (1975)
## 21 Citizen Kane (1941)
## 22 Vertigo (1958)
## 23 Maltese Falcon, The (1941)
## 24 Godfather, The (1972)
## 25 North by Northwest (1959)
## 26 Sling Blade (1996)
## 27 Boot, Das (1981)
## 28 Apt Pupil (1998)
## 29 Henry V (1989)
## 30 Dr. Strangelove or: How I Learned to Stop Worrying and Love the Bomb (1963)
## 31 Godfather: Part II, The (1974)
## 32 Manchurian Candidate, The (1962)
## 33 It's a Wonderful Life (1946)
## 34 Princess Bride, The (1987)
## 35 Fargo (1996)
## 36 Lawrence of Arabia (1962)
## 37 Silence of the Lambs, The (1991)
## 38 Bridge on the River Kwai, The (1957)
## 39 Hoop Dreams (1994)
## 40 African Queen, The (1951)
## 41 Amadeus (1984)
## 42 Braveheart (1995)
## 43 Empire Strikes Back, The (1980)
## 44 Much Ado About Nothing (1993)
## 45 Persuasion (1995)
## 46 Sunset Blvd. (1950)
## 47 Sweet Hereafter, The (1997)
## 48 Taxi Driver (1976)
## 49 Young Frankenstein (1974)
## 50 2001: A Space Odyssey (1968)
## 51 Blade Runner (1982)
## 52 Chinatown (1974)
## 53 Cinema Paradiso (1988)
## 54 Delicatessen (1991)
## 55 Grand Day Out, A (1992)
## 56 Pulp Fiction (1994)
## 57 Raging Bull (1980)
## 58 Air Force One (1997)
## 59 Alien (1979)
## 60 Blues Brothers, The (1980)
## 61 Day the Earth Stood Still, The (1951)
## 62 Dead Poets Society (1989)
## 63 Fantasia (1940)
## 64 Great Escape, The (1963)
## 65 Lone Star (1996)
## 66 Psycho (1960)
## 67 Sense and Sensibility (1995)
## 68 Star Wars (1977)
## 69 Sting, The (1973)
## 70 Terminator 2: Judgment Day (1991)
## 71 Unforgiven (1992)
## 72 Babe (1995)
## 73 Chasing Amy (1997)
## 74 Clockwork Orange, A (1971)
## 75 High Noon (1952)
## 76 Monty Python and the Holy Grail (1974)
## 77 Raiders of the Lost Ark (1981)
## 78 Third Man, The (1949)
## 79 Wizard of Oz, The (1939)
## 80 Apocalypse Now (1979)
## 81 Beauty and the Beast (1991)
## 82 Big Sleep, The (1946)
## 83 Brazil (1985)
## 84 Christmas Carol, A (1938)
## 85 City of Lost Children, The (1995)
## 86 Contact (1997)
## 87 Dead Man Walking (1995)
## 88 Die Hard (1988)
## 89 Forrest Gump (1994)
## 90 Fugitive, The (1993)
## 91 Full Monty, The (1997)
## 92 Gandhi (1982)
## 93 Hunt for Red October, The (1990)
## 94 Leaving Las Vegas (1995)
## 95 Patton (1970)
## 96 Raise the Red Lantern (1991)
## 97 Raising Arizona (1987)
## 98 Reservoir Dogs (1992)
## 99 Return of the Jedi (1983)
## 100 Right Stuff, The (1983)
## 101 Rock, The (1996)
## 102 Shining, The (1980)
## 103 Sneakers (1992)
## 104 Terminator, The (1984)
## 105 This Is Spinal Tap (1984)
## 106 Top Gun (1986)
## 107 Toy Story (1995)
## Count
## 1 75
## 2 68
## 3 62
## 4 58
## 5 56
## 6 46
## 7 42
## 8 42
## 9 41
## 10 40
## 11 39
## 12 31
## 13 31
## 14 30
## 15 29
## 16 27
## 17 26
## 18 24
## 19 24
## 20 18
## 21 17
## 22 17
## 23 16
## 24 15
## 25 15
## 26 15
## 27 13
## 28 12
## 29 12
## 30 11
## 31 11
## 32 10
## 33 9
## 34 9
## 35 8
## 36 8
## 37 8
## 38 7
## 39 7
## 40 6
## 41 6
## 42 6
## 43 5
## 44 5
## 45 5
## 46 5
## 47 5
## 48 5
## 49 5
## 50 4
## 51 4
## 52 4
## 53 4
## 54 4
## 55 4
## 56 4
## 57 4
## 58 3
## 59 3
## 60 3
## 61 3
## 62 3
## 63 3
## 64 3
## 65 3
## 66 3
## 67 3
## 68 3
## 69 3
## 70 3
## 71 3
## 72 2
## 73 2
## 74 2
## 75 2
## 76 2
## 77 2
## 78 2
## 79 2
## 80 1
## 81 1
## 82 1
## 83 1
## 84 1
## 85 1
## 86 1
## 87 1
## 88 1
## 89 1
## 90 1
## 91 1
## 92 1
## 93 1
## 94 1
## 95 1
## 96 1
## 97 1
## 98 1
## 99 1
## 100 1
## 101 1
## 102 1
## 103 1
## 104 1
## 105 1
## 106 1
## 107 1
##
## $rsvd40topNList_df
## Movie
## 1 Wallace & Gromit: The Best of Aardman Animation (1996)
## 2 Close Shave, A (1995)
## 3 Wrong Trousers, The (1993)
## 4 Good Will Hunting (1997)
## 5 Some Folks Call It a Sling Blade (1993)
## 6 Waiting for Guffman (1996)
## 7 Rear Window (1954)
## 8 Casablanca (1942)
## 9 As Good As It Gets (1997)
## 10 Shall We Dance? (1996)
## 11 Kundun (1997)
## 12 Schindler's List (1993)
## 13 12 Angry Men (1957)
## 14 Secrets & Lies (1996)
## 15 Titanic (1997)
## 16 Usual Suspects, The (1995)
## 17 L.A. Confidential (1997)
## 18 Shawshank Redemption, The (1994)
## 19 To Kill a Mockingbird (1962)
## 20 Citizen Kane (1941)
## 21 One Flew Over the Cuckoo's Nest (1975)
## 22 North by Northwest (1959)
## 23 Godfather, The (1972)
## 24 Vertigo (1958)
## 25 Maltese Falcon, The (1941)
## 26 Sling Blade (1996)
## 27 Boot, Das (1981)
## 28 Apt Pupil (1998)
## 29 Fargo (1996)
## 30 Henry V (1989)
## 31 Dr. Strangelove or: How I Learned to Stop Worrying and Love the Bomb (1963)
## 32 Princess Bride, The (1987)
## 33 It's a Wonderful Life (1946)
## 34 Silence of the Lambs, The (1991)
## 35 Manchurian Candidate, The (1962)
## 36 African Queen, The (1951)
## 37 Braveheart (1995)
## 38 Godfather: Part II, The (1974)
## 39 Bridge on the River Kwai, The (1957)
## 40 Lawrence of Arabia (1962)
## 41 Much Ado About Nothing (1993)
## 42 Chinatown (1974)
## 43 Delicatessen (1991)
## 44 Raging Bull (1980)
## 45 Taxi Driver (1976)
## 46 Amadeus (1984)
## 47 Chasing Amy (1997)
## 48 Cinema Paradiso (1988)
## 49 Empire Strikes Back, The (1980)
## 50 Psycho (1960)
## 51 Sweet Hereafter, The (1997)
## 52 2001: A Space Odyssey (1968)
## 53 Dead Poets Society (1989)
## 54 Grand Day Out, A (1992)
## 55 Hoop Dreams (1994)
## 56 Pulp Fiction (1994)
## 57 Star Wars (1977)
## 58 Sunset Blvd. (1950)
## 59 Air Force One (1997)
## 60 Alien (1979)
## 61 Blues Brothers, The (1980)
## 62 Fantasia (1940)
## 63 Graduate, The (1967)
## 64 Leaving Las Vegas (1995)
## 65 Lone Star (1996)
## 66 Persuasion (1995)
## 67 Raiders of the Lost Ark (1981)
## 68 Sting, The (1973)
## 69 Terminator 2: Judgment Day (1991)
## 70 Third Man, The (1949)
## 71 Young Frankenstein (1974)
## 72 Amistad (1997)
## 73 Beauty and the Beast (1991)
## 74 Big Night (1996)
## 75 Clockwork Orange, A (1971)
## 76 Contact (1997)
## 77 Day the Earth Stood Still, The (1951)
## 78 Gandhi (1982)
## 79 Great Escape, The (1963)
## 80 High Noon (1952)
## 81 Patton (1970)
## 82 Reservoir Dogs (1992)
## 83 Sense and Sensibility (1995)
## 84 Sound of Music, The (1965)
## 85 This Is Spinal Tap (1984)
## 86 Wizard of Oz, The (1939)
## 87 Babe (1995)
## 88 Blade Runner (1982)
## 89 Boogie Nights (1997)
## 90 Christmas Carol, A (1938)
## 91 Dead Man Walking (1995)
## 92 Die Hard (1988)
## 93 Duck Soup (1933)
## 94 E.T. the Extra-Terrestrial (1982)
## 95 Eat Drink Man Woman (1994)
## 96 Fugitive, The (1993)
## 97 Full Monty, The (1997)
## 98 Glory (1989)
## 99 Gone with the Wind (1939)
## 100 Hamlet (1996)
## 101 Jaws (1975)
## 102 Lion King, The (1994)
## 103 Monty Python and the Holy Grail (1974)
## 104 Mr. Holland's Opus (1995)
## 105 Raise the Red Lantern (1991)
## 106 Ran (1985)
## 107 Return of the Jedi (1983)
## 108 Richard III (1995)
## 109 Right Stuff, The (1983)
## 110 Rock, The (1996)
## 111 Room with a View, A (1986)
## 112 Rosencrantz and Guildenstern Are Dead (1990)
## 113 Seven (Se7en) (1995)
## 114 Shining, The (1980)
## 115 Singin' in the Rain (1952)
## 116 Sneakers (1992)
## 117 Strictly Ballroom (1992)
## 118 Terminator, The (1984)
## 119 Toy Story (1995)
## 120 Trainspotting (1996)
## 121 Unforgiven (1992)
## Count
## 1 75
## 2 69
## 3 60
## 4 52
## 5 52
## 6 44
## 7 43
## 8 40
## 9 38
## 10 35
## 11 32
## 12 30
## 13 29
## 14 28
## 15 28
## 16 26
## 17 25
## 18 24
## 19 24
## 20 19
## 21 19
## 22 17
## 23 16
## 24 16
## 25 14
## 26 14
## 27 13
## 28 12
## 29 12
## 30 12
## 31 11
## 32 11
## 33 10
## 34 10
## 35 9
## 36 8
## 37 8
## 38 8
## 39 7
## 40 7
## 41 7
## 42 6
## 43 6
## 44 6
## 45 6
## 46 5
## 47 5
## 48 5
## 49 5
## 50 5
## 51 5
## 52 4
## 53 4
## 54 4
## 55 4
## 56 4
## 57 4
## 58 4
## 59 3
## 60 3
## 61 3
## 62 3
## 63 3
## 64 3
## 65 3
## 66 3
## 67 3
## 68 3
## 69 3
## 70 3
## 71 3
## 72 2
## 73 2
## 74 2
## 75 2
## 76 2
## 77 2
## 78 2
## 79 2
## 80 2
## 81 2
## 82 2
## 83 2
## 84 2
## 85 2
## 86 2
## 87 1
## 88 1
## 89 1
## 90 1
## 91 1
## 92 1
## 93 1
## 94 1
## 95 1
## 96 1
## 97 1
## 98 1
## 99 1
## 100 1
## 101 1
## 102 1
## 103 1
## 104 1
## 105 1
## 106 1
## 107 1
## 108 1
## 109 1
## 110 1
## 111 1
## 112 1
## 113 1
## 114 1
## 115 1
## 116 1
## 117 1
## 118 1
## 119 1
## 120 1
## 121 1
##
## $rsvd50topNList_df
## Movie
## 1 Wallace & Gromit: The Best of Aardman Animation (1996)
## 2 Close Shave, A (1995)
## 3 Wrong Trousers, The (1993)
## 4 Some Folks Call It a Sling Blade (1993)
## 5 Good Will Hunting (1997)
## 6 Rear Window (1954)
## 7 Waiting for Guffman (1996)
## 8 Casablanca (1942)
## 9 Shall We Dance? (1996)
## 10 As Good As It Gets (1997)
## 11 Kundun (1997)
## 12 Titanic (1997)
## 13 12 Angry Men (1957)
## 14 L.A. Confidential (1997)
## 15 Secrets & Lies (1996)
## 16 Usual Suspects, The (1995)
## 17 Shawshank Redemption, The (1994)
## 18 Schindler's List (1993)
## 19 Citizen Kane (1941)
## 20 To Kill a Mockingbird (1962)
## 21 Maltese Falcon, The (1941)
## 22 Vertigo (1958)
## 23 Godfather, The (1972)
## 24 One Flew Over the Cuckoo's Nest (1975)
## 25 Boot, Das (1981)
## 26 North by Northwest (1959)
## 27 Apt Pupil (1998)
## 28 Sling Blade (1996)
## 29 Fargo (1996)
## 30 Silence of the Lambs, The (1991)
## 31 It's a Wonderful Life (1946)
## 32 Henry V (1989)
## 33 Manchurian Candidate, The (1962)
## 34 Chasing Amy (1997)
## 35 Dr. Strangelove or: How I Learned to Stop Worrying and Love the Bomb (1963)
## 36 Godfather: Part II, The (1974)
## 37 Bridge on the River Kwai, The (1957)
## 38 Hoop Dreams (1994)
## 39 Lawrence of Arabia (1962)
## 40 Princess Bride, The (1987)
## 41 Wizard of Oz, The (1939)
## 42 Braveheart (1995)
## 43 Chinatown (1974)
## 44 Day the Earth Stood Still, The (1951)
## 45 Much Ado About Nothing (1993)
## 46 Pulp Fiction (1994)
## 47 Raging Bull (1980)
## 48 Taxi Driver (1976)
## 49 African Queen, The (1951)
## 50 Amadeus (1984)
## 51 Cinema Paradiso (1988)
## 52 Great Escape, The (1963)
## 53 Psycho (1960)
## 54 Sweet Hereafter, The (1997)
## 55 Blade Runner (1982)
## 56 Delicatessen (1991)
## 57 Empire Strikes Back, The (1980)
## 58 Persuasion (1995)
## 59 Sense and Sensibility (1995)
## 60 Star Wars (1977)
## 61 Sunset Blvd. (1950)
## 62 Young Frankenstein (1974)
## 63 2001: A Space Odyssey (1968)
## 64 Beauty and the Beast (1991)
## 65 Clockwork Orange, A (1971)
## 66 Grand Day Out, A (1992)
## 67 High Noon (1952)
## 68 Leaving Las Vegas (1995)
## 69 Mr. Holland's Opus (1995)
## 70 Raiders of the Lost Ark (1981)
## 71 Terminator 2: Judgment Day (1991)
## 72 This Is Spinal Tap (1984)
## 73 Air Force One (1997)
## 74 Alien (1979)
## 75 Amistad (1997)
## 76 Babe (1995)
## 77 Blues Brothers, The (1980)
## 78 Contact (1997)
## 79 Dead Man Walking (1995)
## 80 Dead Poets Society (1989)
## 81 Die Hard (1988)
## 82 Duck Soup (1933)
## 83 Fantasia (1940)
## 84 Glory (1989)
## 85 Graduate, The (1967)
## 86 Hamlet (1996)
## 87 Jean de Florette (1986)
## 88 Lone Star (1996)
## 89 Patton (1970)
## 90 Philadelphia Story, The (1940)
## 91 Ran (1985)
## 92 Strictly Ballroom (1992)
## 93 Third Man, The (1949)
## 94 Trainspotting (1996)
## 95 Apocalypse Now (1979)
## 96 Big Night (1996)
## 97 Big Sleep, The (1946)
## 98 Boogie Nights (1997)
## 99 Brazil (1985)
## 100 Breakfast at Tiffany's (1961)
## 101 Christmas Carol, A (1938)
## 102 Con Air (1997)
## 103 Eat Drink Man Woman (1994)
## 104 Forbidden Planet (1956)
## 105 Forrest Gump (1994)
## 106 Fugitive, The (1993)
## 107 Full Monty, The (1997)
## 108 Gandhi (1982)
## 109 Gone with the Wind (1939)
## 110 Harold and Maude (1971)
## 111 Jaws (1975)
## 112 Lion King, The (1994)
## 113 M (1931)
## 114 M*A*S*H (1970)
## 115 Manon of the Spring (Manon des sources) (1986)
## 116 Monty Python and the Holy Grail (1974)
## 117 Raise the Red Lantern (1991)
## 118 Reservoir Dogs (1992)
## 119 Richard III (1995)
## 120 Right Stuff, The (1983)
## 121 Rock, The (1996)
## 122 Room with a View, A (1986)
## 123 Rosencrantz and Guildenstern Are Dead (1990)
## 124 Seven (Se7en) (1995)
## 125 Some Like It Hot (1959)
## 126 Sound of Music, The (1965)
## 127 Sting, The (1973)
## 128 Three Colors: Red (1994)
## 129 Unforgiven (1992)
## 130 When We Were Kings (1996)
## 131 Willy Wonka and the Chocolate Factory (1971)
## Count
## 1 75
## 2 69
## 3 58
## 4 48
## 5 43
## 6 42
## 7 39
## 8 37
## 9 32
## 10 31
## 11 30
## 12 30
## 13 28
## 14 28
## 15 27
## 16 27
## 17 25
## 18 23
## 19 22
## 20 21
## 21 18
## 22 17
## 23 16
## 24 16
## 25 15
## 26 15
## 27 14
## 28 14
## 29 13
## 30 13
## 31 12
## 32 11
## 33 11
## 34 10
## 35 10
## 36 9
## 37 8
## 38 7
## 39 7
## 40 7
## 41 7
## 42 6
## 43 6
## 44 6
## 45 6
## 46 6
## 47 6
## 48 6
## 49 5
## 50 5
## 51 5
## 52 5
## 53 5
## 54 5
## 55 4
## 56 4
## 57 4
## 58 4
## 59 4
## 60 4
## 61 4
## 62 4
## 63 3
## 64 3
## 65 3
## 66 3
## 67 3
## 68 3
## 69 3
## 70 3
## 71 3
## 72 3
## 73 2
## 74 2
## 75 2
## 76 2
## 77 2
## 78 2
## 79 2
## 80 2
## 81 2
## 82 2
## 83 2
## 84 2
## 85 2
## 86 2
## 87 2
## 88 2
## 89 2
## 90 2
## 91 2
## 92 2
## 93 2
## 94 2
## 95 1
## 96 1
## 97 1
## 98 1
## 99 1
## 100 1
## 101 1
## 102 1
## 103 1
## 104 1
## 105 1
## 106 1
## 107 1
## 108 1
## 109 1
## 110 1
## 111 1
## 112 1
## 113 1
## 114 1
## 115 1
## 116 1
## 117 1
## 118 1
## 119 1
## 120 1
## 121 1
## 122 1
## 123 1
## 124 1
## 125 1
## 126 1
## 127 1
## 128 1
## 129 1
## 130 1
## 131 1topN_df_svd_2 <- generate_topN_dfs(rsvd_topN_lists_2)
print("Zweiter Datensatz")## [1] "Zweiter Datensatz"topN_df_svd_2## $rsvd10topNList_df
## Movie Count
## 1 Affair to Remember, An (1957) 80
## 2 Just Cause (1995) 80
## 3 Once Were Warriors (1994) 80
## 4 Paths of Glory (1957) 80
## 5 Sunset Blvd. (1950) 77
## 6 Beautiful Thing (1996) 76
## 7 Ghost in the Shell (Kokaku kidotai) (1995) 76
## 8 Some Folks Call It a Sling Blade (1993) 76
## 9 Casper (1995) 73
## 10 As Good As It Gets (1997) 72
## 11 Antonia's Line (1995) 71
## 12 12 Angry Men (1957) 70
## 13 Strictly Ballroom (1992) 70
## 14 Close Shave, A (1995) 69
## 15 Apt Pupil (1998) 68
## 16 Third Man, The (1949) 25
## 17 Persuasion (1995) 20
## 18 Wrong Trousers, The (1993) 16
## 19 Boomerang (1992) 8
## 20 Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 4
## 21 Amistad (1997) 3
## 22 Reservoir Dogs (1992) 3
## 23 Secrets & Lies (1996) 2
## 24 Spitfire Grill, The (1996) 1
##
## $rsvd20topNList_df
## Movie Count
## 1 Affair to Remember, An (1957) 80
## 2 Just Cause (1995) 80
## 3 Once Were Warriors (1994) 80
## 4 Paths of Glory (1957) 79
## 5 Sunset Blvd. (1950) 77
## 6 Beautiful Thing (1996) 76
## 7 Ghost in the Shell (Kokaku kidotai) (1995) 76
## 8 Some Folks Call It a Sling Blade (1993) 76
## 9 As Good As It Gets (1997) 72
## 10 Casper (1995) 71
## 11 Close Shave, A (1995) 69
## 12 Strictly Ballroom (1992) 69
## 13 Antonia's Line (1995) 65
## 14 12 Angry Men (1957) 63
## 15 Apt Pupil (1998) 44
## 16 Third Man, The (1949) 28
## 17 Wrong Trousers, The (1993) 25
## 18 Persuasion (1995) 22
## 19 Secrets & Lies (1996) 7
## 20 Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 7
## 21 Boomerang (1992) 6
## 22 Lawrence of Arabia (1962) 5
## 23 Reservoir Dogs (1992) 5
## 24 Amistad (1997) 2
## 25 Christmas Carol, A (1938) 2
## 26 Fantasia (1940) 2
## 27 Henry V (1989) 2
## 28 Three Colors: White (1994) 2
## 29 39 Steps, The (1935) 1
## 30 African Queen, The (1951) 1
## 31 Chasing Amy (1997) 1
## 32 Clerks (1994) 1
## 33 Donnie Brasco (1997) 1
## 34 Farewell My Concubine (1993) 1
## 35 Fried Green Tomatoes (1991) 1
## 36 Wallace & Gromit: The Best of Aardman Animation (1996) 1
##
## $rsvd30topNList_df
## Movie Count
## 1 Affair to Remember, An (1957) 80
## 2 Just Cause (1995) 80
## 3 Once Were Warriors (1994) 79
## 4 Paths of Glory (1957) 77
## 5 Sunset Blvd. (1950) 77
## 6 Beautiful Thing (1996) 76
## 7 Some Folks Call It a Sling Blade (1993) 76
## 8 Ghost in the Shell (Kokaku kidotai) (1995) 73
## 9 As Good As It Gets (1997) 72
## 10 Casper (1995) 71
## 11 Close Shave, A (1995) 69
## 12 Strictly Ballroom (1992) 67
## 13 Antonia's Line (1995) 63
## 14 12 Angry Men (1957) 59
## 15 Apt Pupil (1998) 40
## 16 Third Man, The (1949) 29
## 17 Wrong Trousers, The (1993) 22
## 18 Persuasion (1995) 17
## 19 Secrets & Lies (1996) 10
## 20 Reservoir Dogs (1992) 6
## 21 Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 6
## 22 Chasing Amy (1997) 5
## 23 Lawrence of Arabia (1962) 5
## 24 Amistad (1997) 4
## 25 African Queen, The (1951) 3
## 26 Boomerang (1992) 3
## 27 Brassed Off (1996) 3
## 28 Henry V (1989) 3
## 29 Last of the Mohicans, The (1992) 3
## 30 Three Colors: White (1994) 3
## 31 Bridge on the River Kwai, The (1957) 2
## 32 Christmas Carol, A (1938) 2
## 33 Clerks (1994) 2
## 34 Wallace & Gromit: The Best of Aardman Animation (1996) 2
## 35 Big Night (1996) 1
## 36 Chinatown (1974) 1
## 37 Donnie Brasco (1997) 1
## 38 Fantasia (1940) 1
## 39 Farewell My Concubine (1993) 1
## 40 Fried Green Tomatoes (1991) 1
## 41 Ghost and the Darkness, The (1996) 1
## 42 Happy Gilmore (1996) 1
## 43 Hoop Dreams (1994) 1
## 44 Raging Bull (1980) 1
## 45 Sling Blade (1996) 1
##
## $rsvd40topNList_df
## Movie Count
## 1 Affair to Remember, An (1957) 80
## 2 Just Cause (1995) 80
## 3 Once Were Warriors (1994) 77
## 4 Beautiful Thing (1996) 76
## 5 Some Folks Call It a Sling Blade (1993) 76
## 6 Sunset Blvd. (1950) 76
## 7 Paths of Glory (1957) 75
## 8 Ghost in the Shell (Kokaku kidotai) (1995) 73
## 9 As Good As It Gets (1997) 71
## 10 Casper (1995) 70
## 11 Close Shave, A (1995) 69
## 12 Strictly Ballroom (1992) 61
## 13 Antonia's Line (1995) 57
## 14 12 Angry Men (1957) 54
## 15 Apt Pupil (1998) 45
## 16 Wrong Trousers, The (1993) 32
## 17 Third Man, The (1949) 26
## 18 Persuasion (1995) 11
## 19 Secrets & Lies (1996) 10
## 20 Amistad (1997) 6
## 21 Chinatown (1974) 6
## 22 Lawrence of Arabia (1962) 6
## 23 Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 5
## 24 Three Colors: White (1994) 5
## 25 African Queen, The (1951) 4
## 26 Boomerang (1992) 4
## 27 Fantasia (1940) 4
## 28 Reservoir Dogs (1992) 4
## 29 Wallace & Gromit: The Best of Aardman Animation (1996) 4
## 30 Bridge on the River Kwai, The (1957) 3
## 31 Chasing Amy (1997) 3
## 32 Clerks (1994) 3
## 33 Brassed Off (1996) 2
## 34 Donnie Brasco (1997) 2
## 35 Jean de Florette (1986) 2
## 36 Last of the Mohicans, The (1992) 2
## 37 Man Who Would Be King, The (1975) 2
## 38 Manchurian Candidate, The (1962) 2
## 39 Raging Bull (1980) 2
## 40 Sling Blade (1996) 2
## 41 39 Steps, The (1935) 1
## 42 Apostle, The (1997) 1
## 43 Christmas Carol, A (1938) 1
## 44 Enchanted April (1991) 1
## 45 Farewell My Concubine (1993) 1
## 46 Ghost and the Darkness, The (1996) 1
## 47 Henry V (1989) 1
## 48 Room with a View, A (1986) 1
##
## $rsvd50topNList_df
## Movie Count
## 1 Affair to Remember, An (1957) 80
## 2 Just Cause (1995) 80
## 3 Beautiful Thing (1996) 76
## 4 Some Folks Call It a Sling Blade (1993) 76
## 5 Once Were Warriors (1994) 75
## 6 Sunset Blvd. (1950) 75
## 7 Paths of Glory (1957) 74
## 8 Ghost in the Shell (Kokaku kidotai) (1995) 73
## 9 As Good As It Gets (1997) 71
## 10 Close Shave, A (1995) 69
## 11 Casper (1995) 68
## 12 Strictly Ballroom (1992) 58
## 13 Antonia's Line (1995) 53
## 14 12 Angry Men (1957) 52
## 15 Apt Pupil (1998) 37
## 16 Third Man, The (1949) 29
## 17 Wrong Trousers, The (1993) 29
## 18 Persuasion (1995) 17
## 19 Secrets & Lies (1996) 9
## 20 African Queen, The (1951) 8
## 21 Wallace & Gromit: The Best of Aardman Animation (1996) 8
## 22 Lawrence of Arabia (1962) 7
## 23 Reservoir Dogs (1992) 6
## 24 Henry V (1989) 5
## 25 Shanghai Triad (Yao a yao yao dao waipo qiao) (1995) 5
## 26 Amistad (1997) 4
## 27 Boomerang (1992) 4
## 28 Bridge on the River Kwai, The (1957) 4
## 29 Chinatown (1974) 4
## 30 Clerks (1994) 4
## 31 Fantasia (1940) 4
## 32 Three Colors: White (1994) 4
## 33 Chasing Amy (1997) 3
## 34 Christmas Carol, A (1938) 3
## 35 Jean de Florette (1986) 3
## 36 Last of the Mohicans, The (1992) 3
## 37 39 Steps, The (1935) 2
## 38 Glory (1989) 2
## 39 Raging Bull (1980) 2
## 40 Sling Blade (1996) 2
## 41 Apostle, The (1997) 1
## 42 Arsenic and Old Lace (1944) 1
## 43 Big Night (1996) 1
## 44 Brassed Off (1996) 1
## 45 Breaking the Waves (1996) 1
## 46 Farewell My Concubine (1993) 1
## 47 Ghost and the Darkness, The (1996) 1
## 48 Hoop Dreams (1994) 1
## 49 Jackie Brown (1997) 1
## 50 Manchurian Candidate, The (1962) 1
## 51 My Life as a Dog (Mitt liv som hund) (1985) 1
## 52 Three Colors: Red (1994) 1Die ersten fünf Tabellen sind die Resultate für den ersten Datensatz. Es handelt sich aufsteigend um die Anzahl Singulärwerte von 10 bis 50. Die letzten fünf Tabellen beinhalten das gleiche Resultat, einfach für den zweiten Datensatz. Diese Auswertung wird noch nicht für die Beantwortung der Aufgabe verwendet, sondern gab uns einen ersten Überblick über die Resultate
compare_ibcf_svd <- function(ribcf, svd, svd_value) {
intersect <- intersect(ribcf$Movie, svd$Movie)
print(paste("Anzahl gemeinsame Empfehlungen SVD", svd_value, ":", length(intersect)))
print(paste("Gemeinsamer relativer Anteil für Anzahl Singulärwerte", svd_value, ":", length(intersect) / nrow(ribcf) * 100))
}
print("Erster Datensatz")## [1] "Erster Datensatz"compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd10topNList_df, 10)## [1] "Anzahl gemeinsame Empfehlungen SVD 10 : 76"
## [1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 10 : 15.605749486653"compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd20topNList_df, 20)## [1] "Anzahl gemeinsame Empfehlungen SVD 20 : 86"
## [1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 20 : 17.6591375770021"compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd30topNList_df, 30)## [1] "Anzahl gemeinsame Empfehlungen SVD 30 : 93"
## [1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 30 : 19.0965092402464"compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd40topNList_df, 40)## [1] "Anzahl gemeinsame Empfehlungen SVD 40 : 105"
## [1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 40 : 21.5605749486653"compare_ibcf_svd(ribcftopN_df_1, topN_df_svd_1$rsvd50topNList_df, 50)## [1] "Anzahl gemeinsame Empfehlungen SVD 50 : 117"
## [1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 50 : 24.0246406570842"print("Zweiter Datensatz")## [1] "Zweiter Datensatz"compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd10topNList_df, 10)## [1] "Anzahl gemeinsame Empfehlungen SVD 10 : 10"
## [1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 10 : 2.45700245700246"compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd20topNList_df, 20)## [1] "Anzahl gemeinsame Empfehlungen SVD 20 : 20"
## [1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 20 : 4.91400491400491"compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd30topNList_df, 30)## [1] "Anzahl gemeinsame Empfehlungen SVD 30 : 22"
## [1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 30 : 5.40540540540541"compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd40topNList_df, 40)## [1] "Anzahl gemeinsame Empfehlungen SVD 40 : 27"
## [1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 40 : 6.63390663390663"compare_ibcf_svd(ribcftopN_df_2, topN_df_svd_2$rsvd50topNList_df, 50)## [1] "Anzahl gemeinsame Empfehlungen SVD 50 : 27"
## [1] "Gemeinsamer relativer Anteil für Anzahl Singulärwerte 50 : 6.63390663390663"Für den ersten Datensatz werden bei SVD Wert 10 76 gemeinsame Empfehlungen mit IBCF generiert. Dies entspricht einem Anteil von 15.6% der Empfehlungen vom SVD Modell. Bis zur Anzahl von 50 Singulärwerten steigt die Anzahl gemeinsamer Empfehlungen auf 117, was einem Anteil von 24% der Empfehlungen von IBCF entspricht. Für den ersten Datensatz lässt sich also eine stetige Zunahme der Übereinstimmungen und relativer Anteil der Übereinstimmungen feststellen. Eine ähnliche Zunahme lässt sich auch bei dem zweiten Datensatz feststellen. Allerdings sind die Anzahl Übereinstimmungen tiefer und von 40 zu 50 Singulärwerten werden keine zusätzlichen Übereinstimmungen mehr generiert.
Bei der Singulärwertezerlegung und -rekonstruktion werden die Resultate mit steigender Anzahl Singulärwerte zuerst raschen, dann langsamer besser. Ein ähnliches Verhalten sehen wir auch hier. Mit zunehmenden Singulärwerten wird die Übereinstimmung mit den Empfehlungen von IBCF höher. Das lässt nicht direkt den Schluss zu, dass IBCF besser als SVD mit einem tiefen Wert ist, aber die Resultate werden mit zunehmenden Singulärwerten besser.
8 Implementierung Top-N Metriken
Aufgabe 8 (DIY)
8.1 CoverageN
# Testing before creating the CoverageN function
# create ribcf Model
ribcf_8 <- Recommender(MovieLense, "IBCF", param=list(k= 30, method = "cosine"))
#ribcf_8
# predict all movies for every user
ribcftopNList_8 <- predict(ribcf_8, MovieLense, n=15)
#ribcftopNList_8
# get the list of unique items for all user
list_items_8 <- unique(unlist(as(ribcftopNList_8, "list"), use.names = FALSE))
#list_items_8
# get the length of this list
len_items_8 <- length(list_items_8)
paste("Top-N Liste der Kunden:", len_items_8)## [1] "Top-N Liste der Kunden: 694"# get length of total items
len_all_items_8 <- dim(MovieLense)[2]
paste("Menge aller Produkte:", len_all_items_8)## [1] "Menge aller Produkte: 1664"# calculate coverageN
coverageN <- len_items_8 / len_all_items_8
paste("coverageN fuer ribcf_8 model mit n = 15", round(coverageN, 4))## [1] "coverageN fuer ribcf_8 model mit n = 15 0.4171"# create a function
coverageN <- function(model, n, dataset) {
# predict all movies for every user
topNList <- predict(model, dataset, n = n)
# get the list of unique items for all users
list_items <- unique(unlist(as(topNList, "list"), use.names = FALSE))
# get the length of this list
len_items <- length(list_items)
# get length of total items
len_all_items <- dim(dataset)[2]
# calculate coverage
coverage <- len_items / len_all_items
return(coverage)
}
ribcf_8_coverage <- coverageN(ribcf_8, 15, MovieLense)
paste("Coverage fuer ribcf_8 model mit n = 15:", round(ribcf_8_coverage, 4))## [1] "Coverage fuer ribcf_8 model mit n = 15: 0.4171"# List of n values
n_val <- c(5, 10, 15, 20, 25, 30)
n_dataset <- c(MovieLense, MovieLenseCompact_1, MovieLenseCompact_2)
# Create empty list
coverage_values <- c()
for (dataset in n_dataset) {
# For loop to iterate over n_values
ribcf_i <- Recommender(dataset, "IBCF", param=list(k= 30, method = "cosine"))
print(dataset)
for (n in n_val) {
# calculate coverageN with ribcf_8
coverage <- coverageN(ribcf_i, n, dataset)
coverage_values <- c(coverage_values, coverage)
print(paste("Coverage for n =", n, round(coverage, 4)))
}
}## 943 x 1664 rating matrix of class 'realRatingMatrix' with 99392 ratings.
## [1] "Coverage for n = 5 0.2344"
## [1] "Coverage for n = 10 0.3341"
## [1] "Coverage for n = 15 0.4171"
## [1] "Coverage for n = 20 0.4874"
## [1] "Coverage for n = 25 0.5379"
## [1] "Coverage for n = 30 0.5823"
## 400 x 700 rating matrix of class 'realRatingMatrix' with 67427 ratings.
## [1] "Coverage for n = 5 0.7171"
## [1] "Coverage for n = 10 0.9014"
## [1] "Coverage for n = 15 0.9629"
## [1] "Coverage for n = 20 0.9743"
## [1] "Coverage for n = 25 0.9829"
## [1] "Coverage for n = 30 0.9886"
## 400 x 700 rating matrix of class 'realRatingMatrix' with 17784 ratings.
## [1] "Coverage for n = 5 0.56"
## [1] "Coverage for n = 10 0.7986"
## [1] "Coverage for n = 15 0.9014"
## [1] "Coverage for n = 20 0.9686"
## [1] "Coverage for n = 25 0.9914"
## [1] "Coverage for n = 30 0.9971"Space Beitrag über Coverage: https://spaces.technik.fhnw.ch/spaces/recommender-systems/beitraege/recommender-system-evaluierung-coverage-und-novelty-1
Zur Überprüfung des Datensatzes haben wir die Anzahl Filme des aktuellen MovieLense Datensatzes ausgegeben, er beträgt weiterhin 1’664 Items. Unsere Berechnung anhand der Formel, die du im Space unter Beiträge gepostet hast, ergibt, dass 41.7 % der vorhandenen Filme empfohlen werden. Dies bestätigt unsere Erkenntnis aus Aufgabe 5, wonach nicht allen Usern die gleichen Items empfohlen werden. Auch erkennen wir, das durch die steigende Anzahl an n (Anzahl Items Empfehlung) erhöht sich auch entsprechend Coverage, was auch Sinn macht denn der Zähler, sprich die Anzahl einzigartige Filmen grösser sind bei einer grösseren Anzahl n, da mehr Filme für jeden User vorgeschlagen werden. Diese Beobachung können wir beim kompletten MovieLense Datensatz sowie bei den beiden reduzierten Datensätzen sehen.
8.2 NoveltyN
nratings(MovieLense) / len_all_items_8## [1] 59.73077# Kreuztabelle erstellen Item vs Anzahl Rating
movie_ratings_counts <- table(MovieLenseEDA$item)
# dividieren durch Gesamtanzahl Item im Datensatz und logarithmieren
log_popularity <- log(movie_ratings_counts/dim(MovieLenseEDA)[2])
# Von jedem Film die Popularity als Dataframe
log_pop_df <- data.frame(log_popularity = log_popularity)
log_pop_df# Anzahl User
S_user <- dim(MovieLense)[1]
paste("Anzahl aller Kunden", S_user)## [1] "Anzahl aller Kunden 943"# Anzahl Items
N_item <- dim(MovieLense)[2]
paste("Anzahl aller Items", N_item)## [1] "Anzahl aller Items 1664"# Model
ribcf_model <- Recommender(MovieLense, "IBCF", param=list(k= 30, method = "cosine"))
# get prediction for every user
ribcf_model_prediction <- predict(ribcf_8, MovieLense, n=15)
ribcf_model_prediction_list <- unlist(as(ribcf_model_prediction, "list"), use.names = FALSE)
# create a dataframe
ribcf_model_prediction_df <- data.frame(ribcf_model_prediction_list)
# join ribcf_model_prediction_df and log_pop_df
join_df <- merge(ribcf_model_prediction_df, log_pop_df, by.x = "ribcf_model_prediction_list", by.y = "log_popularity.Var1")
novelty <- -1/N_item * sum(join_df$log_popularity.Freq) / S_user
novelty## [1] 0.0001956961# create function
novelty <- function(dataset, model, n) {
movie_ratings_counts <- table(dataset$item)
log_popularity <- log(movie_ratings_counts/dim(dataset)[2])
log_pop_df <- data.frame(log_popularity = log_popularity)
S_user <- dim(dataset)[1]
N_item <- dim(dataset)[2]
ribcf_model_prediction <- predict(model, dataset, n)
ribcf_model_prediction_list <- unlist(as(ribcf_model_prediction, "list"), use.names = FALSE)
ribcf_model_prediction_df <- data.frame(ribcf_model_prediction_list)
join_df <- merge(ribcf_model_prediction_df, log_pop_df, by.x = "ribcf_model_prediction_list", by.y = "log_popularity.Var1")
novelty <- -1/N_item * sum(join_df$log_popularity.Freq) / S_user
return(novelty)
}
ribcf_model <- Recommender(MovieLense, "IBCF", param=list(k= 30, method = "cosine"))
#novelty(MovieLenseEDA, ribcf_model, 15)
# funktioniert nichtWieder in Anlehnung an deine Beschreibung dividieren wir die Anzahl sämtlicher Ratings durch die Anzahl Items. Das Resultat sagt aus, dass rund 60 mal mehr Ratings abgegeben wurden, als Items vorhanden sind.
to-do: Stimmt Berechnung von 8.2? Unterschiedliche Listenlängen!
9 Wahl des optimalen Recommenders
Aufgabe 9 ## 9.1 Verwende für die Evaluierung 10-fache Kreuzvalidierung
set.seed(1234)
scheme_1 <- evaluationScheme(MovieLenseCompact_1, method="cross-validation", k = 10, given=3, goodRating=5)
scheme_2 <- evaluationScheme(MovieLenseCompact_2, method="cross-validation", k = 10, given=3, goodRating=5)
print("Erste Datenreduktion")## [1] "Erste Datenreduktion"scheme_1## Evaluation scheme with 3 items given
## Method: 'cross-validation' with 10 run(s).
## Good ratings: >=5.000000
## Data set: 400 x 700 rating matrix of class 'realRatingMatrix' with 67427 ratings.print("Zweite Datenreduktion")## [1] "Zweite Datenreduktion"scheme_2## Evaluation scheme with 3 items given
## Method: 'cross-validation' with 10 run(s).
## Good ratings: >=5.000000
## Data set: 400 x 700 rating matrix of class 'realRatingMatrix' with 17784 ratings.9.2 Begründe deine Wahl von Metriken und Modell
algorithms <- list("hybrid" = list(name = "HYBRID", param =list(recommenders = list(SVD = list(name="SVD", param=list(k = 40)),
POPULAR = list(name = "POPULAR", param = NULL)
))),
"libmf" = list(name="LIBMF", param=list(dim=10)),
"popular items" = list(name="POPULAR", param=NULL),
"user-based CF" = list(name="UBCF", param=list(nn=50)),
"item-based CF" = list(name="IBCF", param=list(k=50)),
"SVD40" = list(name="SVD", param=list(k = 40)))
print("Erster Datensatz")## [1] "Erster Datensatz"results_1 <- evaluate(scheme_1, algorithms, type = "topNList", n=c(10, 15, 20, 25, 30))## HYBRID run fold/sample [model time/prediction time]
## 1 [0.48sec/0.3sec]
## 2 [0.34sec/0.25sec]
## 3 [0.36sec/0.26sec]
## 4 [0.31sec/0.32sec]
## 5 [0.37sec/0.23sec]
## 6 [0.36sec/0.32sec]
## 7 [0.48sec/0.25sec]
## 8 [0.58sec/0.55sec]
## 9 [0.66sec/0.29sec]
## 10 [0.37sec/0.38sec]
## LIBMF run fold/sample [model time/prediction time]
## 1 [0sec/0.34sec]
## 2 [0sec/0.4sec]
## 3 [0sec/0.32sec]
## 4 [0.02sec/0.3sec]
## 5 [0sec/0.3sec]
## 6 [0sec/0.28sec]
## 7 [0sec/0.26sec]
## 8 [0sec/0.22sec]
## 9 [0sec/0.26sec]
## 10 [0sec/0.29sec]
## POPULAR run fold/sample [model time/prediction time]
## 1 [0.01sec/0.08sec]
## 2 [0.01sec/0.14sec]
## 3 [0.02sec/0.11sec]
## 4 [0.02sec/0.07sec]
## 5 [0sec/0.09sec]
## 6 [0.04sec/0.17sec]
## 7 [0.01sec/0.1sec]
## 8 [0.03sec/0.11sec]
## 9 [0.01sec/0.11sec]
## 10 [0.01sec/0.08sec]
## UBCF run fold/sample [model time/prediction time]
## 1 [0sec/0.43sec]
## 2 [0sec/0.52sec]
## 3 [0.01sec/0.29sec]
## 4 [0.02sec/0.34sec]
## 5 [0.02sec/0.4sec]
## 6 [0.03sec/0.72sec]
## 7 [0.01sec/0.7sec]
## 8 [0.04sec/0.61sec]
## 9 [0.02sec/0.45sec]
## 10 [0sec/0.39sec]
## IBCF run fold/sample [model time/prediction time]
## 1 [1.58sec/0.03sec]
## 2 [1.53sec/0.03sec]
## 3 [2.28sec/0.05sec]
## 4 [2.53sec/0.03sec]
## 5 [2.66sec/0.05sec]
## 6 [2.94sec/0.03sec]
## 7 [2.19sec/0.03sec]
## 8 [2.06sec/0.03sec]
## 9 [2sec/0.05sec]
## 10 [2.3sec/0.07sec]
## SVD run fold/sample [model time/prediction time]
## 1 [0.44sec/0.08sec]
## 2 [0.37sec/0.05sec]
## 3 [0.4sec/0.06sec]
## 4 [0.47sec/0.17sec]
## 5 [0.66sec/0.1sec]
## 6 [0.64sec/0.13sec]
## 7 [0.59sec/0.16sec]
## 8 [0.86sec/0.14sec]
## 9 [0.67sec/0.08sec]
## 10 [0.54sec/0.07sec]print("Zweiter Datensatz")## [1] "Zweiter Datensatz"results_2 <- evaluate(scheme_2, algorithms, type = "topNList", n=c(10, 15, 20, 25, 30))## HYBRID run fold/sample [model time/prediction time]
## 1 [0.49sec/0.23sec]
## 2 [0.34sec/0.27sec]
## 3 [0.31sec/0.24sec]
## 4 [0.31sec/0.28sec]
## 5 [0.33sec/0.35sec]
## 6 [0.34sec/0.25sec]
## 7 [0.31sec/0.28sec]
## 8 [0.33sec/0.51sec]
## 9 [0.57sec/0.47sec]
## 10 [0.52sec/0.53sec]
## LIBMF run fold/sample [model time/prediction time]
## 1 [0.01sec/0.19sec]
## 2 [0sec/0.12sec]
## 3 [0sec/0.49sec]
## 4 [0sec/0.15sec]
## 5 [0sec/0.14sec]
## 6 [0sec/0.14sec]
## 7 [0sec/0.13sec]
## 8 [0sec/0.15sec]
## 9 [0sec/0.09sec]
## 10 [0sec/0.19sec]
## POPULAR run fold/sample [model time/prediction time]
## 1 [0.01sec/0.08sec]
## 2 [0sec/0.08sec]
## 3 [0sec/0.08sec]
## 4 [0sec/0.17sec]
## 5 [0.02sec/0.11sec]
## 6 [0.03sec/0.14sec]
## 7 [0sec/0.08sec]
## 8 [0.01sec/0.11sec]
## 9 [0sec/0.1sec]
## 10 [0sec/0.09sec]
## UBCF run fold/sample [model time/prediction time]
## 1## Zeitnahme beendet um: 0.08 0.02 0.09## Error in h(simpleError(msg, call)) :
## Fehler bei der Auswertung des Argumentes 'x' bei der Methodenauswahl für Funktion 't': noch nicht implementierte Methode für <dgCMatrix> %*% <list>
## IBCF run fold/sample [model time/prediction time]
## 1 [0.73sec/0.01sec]
## 2 [1.04sec/0.01sec]
## 3 [0.97sec/0.01sec]
## 4 [0.86sec/0.02sec]
## 5 [0.94sec/0.01sec]
## 6 [1.01sec/0.02sec]
## 7 [0.85sec/0.01sec]
## 8 [0.94sec/0.02sec]
## 9 [0.74sec/0.01sec]
## 10 [0.98sec/0.04sec]
## SVD run fold/sample [model time/prediction time]
## 1 [0.69sec/0.08sec]
## 2 [0.48sec/0.11sec]
## 3 [0.55sec/0.05sec]
## 4 [0.36sec/0.06sec]
## 5 [0.47sec/0.11sec]
## 6 [0.34sec/0.08sec]
## 7 [0.3sec/0.04sec]
## 8 [0.62sec/0.1sec]
## 9 [0.66sec/0.11sec]
## 10 [0.61sec/0.1sec]## Warning in .local(x, method, ...):
## Recommender 'user-based CF' has failed and has been removed from the results!Dieser Print sagt nur aus, wie lange einzelne Berechnungen gedauert haben. Wir kommentieren ihn deshalb nicht vertieft.
plot(results_1, annotate=c(1,3), legend="topleft")
plot(results_2, annotate=c(1,3), legend="topleft")
9.3 Analysiere das beste Modell für Top-N Recommendations mit N = 10, 15, 20, 25 und 30,
In Aufgabe 9.2 haben wir eine ROC Kurve gemäss Vorlage von Recommenderlab erstellt. Auf der x-Achse befindet sich die FPR (false positive rate) und auf der y-Achse die TPR (true positive rate). Die Methode popular items generiert den tiefsten FPR und TPR für N = 10. Da die selbe Methode bis N = 30 das beste Verhältnis (höchste Kurve und höchster AUC) aufweist, ist dies das beste Modell. Den zweiten Platz teilen sich das hybride Modell und SVD mit 40 Werten. Die Kurve der beiden liegt ständig übereinander. Am schlechtesten hat das item-based CF Model abgeschnitten, welches zwar gleich wie das user-based angefangen hat, dann aber die TPR nicht mehr gleich stark verbessern konnte.
Beim zweiten Datensatz haben die Modell das gleiche Resultat generiert, ausser, dass die mittleren Modell näher zusammen liegen und item-based stärker zurück liegt. Für diesen Datensatz konnte das Modell von Recommenderlab kein Resultat für user-based berechnen. Die entsprechende Fehlermeldung ist auch bei der Generierung in Aufgabe 9.2 aufgetaucht.
Nachdem, was wir über Recommender Systems gelernt haben, haben wir eigentlich nicht erwartet, dass das popular Modell am besten abschneidet. Wir haben eher erwartet, dass du uns einen Datensatz gibst, bei dem user- und item-based besser abschneiden, weil wir im Lernmaterial viel darüber gelernt haben. Da das Resultat genau umgekehrt ist, haben wir überprüft, ob ein Fehler vorliegen könnte, wir haben diesen aber nicht gefunden.
Beim Vergleich der beiden Datensätze gehen wir davon aus, dass die tiefer TPR und leicht höhere FPR davon kommt, dass die Matrix erkennbar sparser ist und damit weniger Trainingsdaten vorhanden sind.
9.4 Optimiere dein bestes Modell hinsichtlich Hyperparametern
algorithmsimprovedrecom <- list("popular items center" = list(name="POPULAR", param=NULL),
"popular items Z-score" = list(name="POPULAR", param=list(normalize="Z-score")))
resultsimprovedrecom_1 <- evaluate(scheme_1, algorithmsimprovedrecom, type = "topNList", n=c(10, 15, 20, 25, 30))## POPULAR run fold/sample [model time/prediction time]
## 1 [0sec/0.09sec]
## 2 [0.01sec/0.08sec]
## 3 [0.02sec/0.09sec]
## 4 [0.04sec/0.09sec]
## 5 [0.02sec/0.08sec]
## 6 [0.03sec/0.13sec]
## 7 [0.03sec/0.18sec]
## 8 [0.02sec/0.13sec]
## 9 [0.01sec/0.24sec]
## 10 [0.04sec/0.18sec]
## POPULAR run fold/sample [model time/prediction time]
## 1 [0.05sec/0.12sec]
## 2 [0.04sec/0.07sec]
## 3 [0.06sec/0.17sec]
## 4 [0.06sec/0.17sec]
## 5 [0.03sec/0.21sec]
## 6 [0.06sec/0.15sec]
## 7 [0.04sec/0.14sec]
## 8 [0.05sec/0.09sec]
## 9 [0.05sec/0.16sec]
## 10 [0.03sec/0.14sec]resultsimprovedrecom_2 <- evaluate(scheme_2, algorithmsimprovedrecom, type = "topNList", n=c(10, 15, 20, 25, 30))## POPULAR run fold/sample [model time/prediction time]
## 1 [0sec/0.13sec]
## 2 [0.02sec/0.11sec]
## 3 [0.01sec/0.11sec]
## 4 [0.01sec/0.16sec]
## 5 [0.01sec/0.14sec]
## 6 [0.01sec/0.13sec]
## 7 [0sec/0.2sec]
## 8 [0.02sec/0.2sec]
## 9 [0sec/0.17sec]
## 10 [0.02sec/0.14sec]
## POPULAR run fold/sample [model time/prediction time]
## 1 [0.05sec/0.17sec]
## 2 [0.05sec/0.13sec]
## 3 [0.02sec/0.18sec]
## 4 [0.06sec/0.19sec]
## 5 [0.03sec/0.09sec]
## 6 [0.03sec/0.17sec]
## 7 [0.03sec/0.1sec]
## 8 [0.03sec/0.16sec]
## 9 [0.01sec/0.08sec]
## 10 [0.04sec/0.07sec]plot(resultsimprovedrecom_1, annotate=c(1,3), legend="topleft")
plot(resultsimprovedrecom_2, annotate=c(1,3), legend="topleft")
Nachdem wir festgestellt haben, dass popular das beste Modell ist, blieb uns für die Optimierung der Hyperparameter nur die Anpassung der Normierung. Einerseits steht die klassische Zentralisierung der Daten und andererseits die Normierung mittels Z-Score zur Verfügung. Das Modell hat mit den selben N Werten keine sichtbaren Unterschiede zwischen den Normierungsmethoden generiert. Das gilt für beide Datensätze. Da die dargestellte Berechnungsdauer für beide Methoden gleich lang ist, entscheiden wir uns für die normale Normierung, da diese einfacher zu berechnen ist. Wir erwarten dadurch einen Performancevorteil bei grösseren Datensätzen.
10 Implementierung Top-N Monitor
Aufgabe 10 (DIY): Untersuche die relative Übereinstimmung zwischen Top-N Empfehlungen und präferierten Filmen für 4 unterschiedliche Modelle (z.B. IBCF und UBCF mit unterschiedlichen Ähnlichkeitsmetriken / Nachbarschaften sowie SVD mit unterschiedlicher Dimensionalitätsreduktion).
10.1 Fixiere 20 zufällig gewählte Testkunden für alle Modellvergleiche,
# Testing before creating function
# select 20 random users
set.seed(1234)
testUsers <- sample(1:nrow(MovieLense), 20)
testUsers## [1] 284 848 918 101 623 905 645 934 400 900 98 103 726 602 326 79 884 270 382
## [20] 184# filter MovieLense by testUsers
MovieLenseTest <- MovieLense[testUsers,]
MovieLenseTest## 20 x 1664 rating matrix of class 'realRatingMatrix' with 1641 ratings.In dieser Zelle haben wir die Auswahl der zufälligen Kunden getestet, bevor wir eine Funktion erstellen.
# create function for select random users
select_random_users <- function(data, num_users, seed) {
set.seed(seed)
testUsers <- sample(1:nrow(data), num_users)
dataTest <- data[testUsers,]
return(list(testUsers, dataTest))
}
select_random_user <- select_random_users(MovieLense, 20, 1234)
testUsers <- select_random_user[[1]]
MovieLenseTest <- select_random_user[[2]]
testUsers## [1] 284 848 918 101 623 905 645 934 400 900 98 103 726 602 326 79 884 270 382
## [20] 184MovieLenseTest## 20 x 1664 rating matrix of class 'realRatingMatrix' with 1641 ratings.Nun haben wir die Funktion erstellt und sie auf dem gleichen Datensatz getestet. Das Resultat ist wieder das gleiche.
# Make for both datasets
# dataset 1
select_random_user_1 <- select_random_users(MovieLenseCompact_1, 20, 1234)
testUsers_1 <- select_random_user_1[[1]]
MovieLenseTest_1 <- select_random_user_1[[2]]
testUsers_1## [1] 284 336 101 111 393 133 388 98 103 214 90 326 79 372 270 382 184 62 4
## [20] 149MovieLenseTest_1## 20 x 700 rating matrix of class 'realRatingMatrix' with 3234 ratings.# dataset 2
select_random_user_2 <- select_random_users(MovieLenseCompact_2, 20, 123)
testUsers_2 <- select_random_user_2[[1]]
MovieLenseTest_2 <- select_random_user_2[[2]]
testUsers_2## [1] 179 14 195 306 118 299 229 244 399 374 153 90 91 256 197 388 348 137 355
## [20] 328MovieLenseTest_2## 20 x 700 rating matrix of class 'realRatingMatrix' with 716 ratings.Wir haben nun die Funtkion auf beide reduzierten Datensätze angewendet. Da der selbe Seed trotzdem die gleichen User ausgewählt hat, mussten wir ihn unterschiedlich definieren.
10.2 Bestimme den Anteil der Top-N Empfehlung nach Genres pro Kunde,
# Modelle erstellen
ribcf_10 <- Recommender(MovieLenseTest, "IBCF", param=list(k= 30, method = "cosine"))
rubcf_10 <- Recommender(MovieLenseTest, "UBCF", parameter=list(method = "Euclidean", nn = 10, normalize = "Z-score"))
rsvd_3 <- Recommender(MovieLenseTest, "SVD", param = list(k = 3))
rsvd_5 <- Recommender(MovieLenseTest, "SVD", param = list(k = 5))Hier haben wir die vier Modelle trainiert.
#ribcf_10
# predict Top-N items for every user
ribcftopNList_10 <- predict(ribcf_10, MovieLenseTest, n=15)
# create a list with the topN items for every user
ribcftopNList_10_list <- as(ribcftopNList_10, "list")
# create a tibble with the topN items for every user
ribcftopNList_10_tibble <- as_tibble(ribcftopNList_10_list)
# transform the tibble to a data frame
ribcftopNList_10_df <- as.data.frame(ribcftopNList_10_tibble)
# replace colname with testUsers
colnames(ribcftopNList_10_df) <- testUsers
# transpose data frame
ribcftopNList_10_df_transposed <- t(ribcftopNList_10_df)
# change ribcftopNList_10_df_transposed to a tibble
ribcftopNList_10_df_transposed_tibble <- as_tibble(ribcftopNList_10_df_transposed)## Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if `.name_repair` is omitted as of tibble 2.0.0.
## Using compatibility `.name_repair`.# add a column with the testUsers
ribcftopNList_10_df_transposed_tibble$testUsers <- testUsers
# pivot longer dataframe
ribcftopNList_10_df_transposed_tibble_pivot <- pivot_longer(ribcftopNList_10_df_transposed_tibble, cols = 1:15, names_to = "topN", values_to = "itemID")
# get genre from each item
ribcftopNList_10_df_transposed_tibble_pivot_genre <- left_join(ribcftopNList_10_df_transposed_tibble_pivot, MovieLenseMeta, by = c("itemID" = "title"))
ribcftopNList_10_df_transposed_tibble_pivot_genre# drop columns topN, year, url
ribcftopNList_10_df_transposed_tibble_pivot_genre <- select(ribcftopNList_10_df_transposed_tibble_pivot_genre, -topN, -year, -url, -itemID)
ribcftopNList_10_df_transposed_tibble_pivot_genreDiese und die nächste Zelle stellt unser Testing der Auswertung dar.
# pivot longer dataframe
topnmonitor_recom <- ribcftopNList_10_df_transposed_tibble_pivot_genre %>% group_by(testUsers) %>%
summarise(across(everything(), ~ sum(., is.na(.), 0)))
topnmonitor_recomget_top_n_items <- function(model, dataset, userlist) {
# predict Top-N items for every user
top_n_list <- predict(model, dataset, n = 15)
print(top_n_list)
# create a list with the topN items for every user
top_n_list_list <- as(top_n_list, "list")
# create a tibble with the topN items for every user
top_n_list_tibble <- as_tibble(top_n_list_list)
# transform the tibble to a data frame
top_n_list_df <- as.data.frame(top_n_list_tibble)
# replace colname with testUsers
colnames(top_n_list_df) <- userlist
# transpose data frame
top_n_list_df_transposed <- t(top_n_list_df)
# change top_n_list_df_transposed to a tibble
top_n_list_df_transposed_tibble <- as_tibble(top_n_list_df_transposed)
# add a column with the testUsers
top_n_list_df_transposed_tibble$testUsers <- userlist
# pivot longer dataframe
top_n_list_df_transposed_tibble_pivot <- pivot_longer(top_n_list_df_transposed_tibble, cols = 1:15, names_to = "topN", values_to = "itemID")
# get genre from each item
top_n_list_df_transposed_tibble_pivot_genre <- left_join(top_n_list_df_transposed_tibble_pivot, MovieLenseMeta, by = c("itemID" = "title"))
# drop columns topN, year, url
top_n_list_df_transposed_tibble_pivot_genre <- select(top_n_list_df_transposed_tibble_pivot_genre, -topN, -year, -url, -itemID)
return(top_n_list_df_transposed_tibble_pivot_genre)
}
ribcftopNList_10_df_transposed_tibble_pivot_genre <- get_top_n_items(ribcf_10, MovieLenseTest, testUsers)## Recommendations as 'topNList' with n = 15 for 20 users.ribcftopNList_10_df_transposed_tibble_pivot_genreDiese Zelle war ein Testing der neu geschriebenen Funktion.
# both datasets
n_dataset <- list(MovieLenseCompact_1, MovieLenseCompact_2)
cnt <- 1
top_n_list <- list()
for (i in 1:length(n_dataset)) {
select_random_user <- select_random_users(n_dataset[[i]], 20, 1234)
testUser_i <- select_random_user[[1]]
MovieLense_i <- select_random_user[[2]]
ribcf_10 <- Recommender(n_dataset[[i]], "IBCF", param=list(k= 30, method = "cosine"))
rubcf_10 <- Recommender(n_dataset[[i]], "UBCF", parameter=list(method = "Euclidean", nn = 10, normalize = "Z-score"))
rsvd_3 <- Recommender(n_dataset[[i]], "SVD", param = list(k = 3))
rsvd_5 <- Recommender(n_dataset[[i]], "SVD", param = list(k = 5))
n_models <- list(ribcf_10, rubcf_10, rsvd_3, rsvd_5)
print(n_dataset[i])
for (j in 1:length(n_models)) {
get_top_n_items_df <- get_top_n_items(n_models[[j]], MovieLense_i, testUser_i)
topnmonitor_recom <- get_top_n_items_df %>% group_by(testUsers) %>%
summarise(across(everything(), ~ sum(., is.na(.), 0)))
top_n_list[[cnt]] <- topnmonitor_recom
cnt <- cnt + 1
}
} ## [[1]]
## 400 x 700 rating matrix of class 'realRatingMatrix' with 67427 ratings.
##
## Recommendations as 'topNList' with n = 15 for 20 users.
## Recommendations as 'topNList' with n = 15 for 20 users.
## Recommendations as 'topNList' with n = 15 for 20 users.
## Recommendations as 'topNList' with n = 15 for 20 users.
## [[1]]
## 400 x 700 rating matrix of class 'realRatingMatrix' with 17784 ratings.
##
## Recommendations as 'topNList' with n = 15 for 20 users.
## Recommendations as 'topNList' with n = 15 for 20 users.
## Recommendations as 'topNList' with n = 15 for 20 users.
## Recommendations as 'topNList' with n = 15 for 20 users.top_n_list## [[1]]
## # A tibble: 20 × 20
## testUsers unknown Action Adventure Anima…¹ Child…² Comedy Crime Docum…³ Drama
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 4 0 4 1 1 1 5 0 0 10
## 2 62 0 4 1 2 2 4 1 0 5
## 3 79 0 2 2 1 1 6 0 0 8
## 4 90 0 4 1 1 2 5 1 0 8
## 5 98 0 1 1 1 1 4 0 0 7
## 6 101 0 3 1 0 1 5 2 0 5
## 7 103 0 2 1 0 0 3 0 1 10
## 8 111 0 0 0 0 2 7 3 0 7
## 9 133 0 1 2 2 2 4 1 1 7
## 10 149 0 0 1 0 1 6 2 0 7
## 11 184 0 2 0 0 0 6 1 0 6
## 12 214 0 5 3 0 1 2 2 0 5
## 13 270 0 4 2 0 0 3 2 0 9
## 14 284 0 2 4 0 4 4 2 0 5
## 15 326 0 4 2 1 1 3 3 0 9
## 16 336 0 2 0 0 1 2 1 0 8
## 17 372 0 1 3 1 1 3 1 0 8
## 18 382 0 2 1 0 0 3 0 1 10
## 19 388 0 4 1 1 1 3 1 0 7
## 20 393 0 2 3 2 3 5 0 0 5
## # … with 10 more variables: Fantasy <dbl>, `Film-Noir` <dbl>, Horror <dbl>,
## # Musical <dbl>, Mystery <dbl>, Romance <dbl>, `Sci-Fi` <dbl>,
## # Thriller <dbl>, War <dbl>, Western <dbl>, and abbreviated variable names
## # ¹Animation, ²`Children's`, ³Documentary
##
## [[2]]
## # A tibble: 20 × 20
## testUsers unknown Action Adventure Anima…¹ Child…² Comedy Crime Docum…³ Drama
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 4 0 3 1 3 0 7 2 0 6
## 2 62 0 1 0 1 0 7 1 0 6
## 3 79 0 3 0 1 0 7 0 0 6
## 4 90 0 1 1 0 0 3 2 0 10
## 5 98 0 2 1 0 1 4 0 0 10
## 6 101 0 1 0 0 0 2 2 0 13
## 7 103 0 2 1 2 0 3 1 0 6
## 8 111 0 0 0 0 0 3 0 0 12
## 9 133 0 1 1 0 0 4 4 1 8
## 10 149 0 0 1 2 0 4 1 0 7
## 11 184 0 2 1 0 0 4 2 1 6
## 12 214 0 1 2 1 1 4 0 1 9
## 13 270 0 2 3 0 1 4 0 0 5
## 14 284 0 2 1 1 0 3 2 0 6
## 15 326 0 2 1 1 0 2 1 0 7
## 16 336 0 0 1 0 1 2 1 1 10
## 17 372 0 0 2 0 0 5 1 0 9
## 18 382 0 1 0 0 0 5 1 1 9
## 19 388 0 2 3 0 0 5 1 0 6
## 20 393 0 4 0 0 0 4 3 1 7
## # … with 10 more variables: Fantasy <dbl>, `Film-Noir` <dbl>, Horror <dbl>,
## # Musical <dbl>, Mystery <dbl>, Romance <dbl>, `Sci-Fi` <dbl>,
## # Thriller <dbl>, War <dbl>, Western <dbl>, and abbreviated variable names
## # ¹Animation, ²`Children's`, ³Documentary
##
## [[3]]
## # A tibble: 20 × 20
## testUsers unknown Action Adventure Anima…¹ Child…² Comedy Crime Docum…³ Drama
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 4 0 3 3 3 0 3 1 0 8
## 2 62 0 1 0 3 0 6 1 1 7
## 3 79 0 2 0 2 0 4 0 0 6
## 4 90 0 1 0 3 0 4 2 0 6
## 5 98 0 1 0 0 0 3 3 0 9
## 6 101 0 2 0 0 0 3 3 1 10
## 7 103 0 8 5 3 0 3 0 0 6
## 8 111 0 0 1 1 0 3 0 0 7
## 9 133 0 1 1 2 0 5 1 0 6
## 10 149 0 2 0 3 0 5 2 0 7
## 11 184 0 2 2 2 0 2 2 0 9
## 12 214 0 2 2 1 0 4 2 0 9
## 13 270 0 2 1 0 0 4 1 0 6
## 14 284 0 0 1 3 0 5 2 0 5
## 15 326 0 2 0 3 0 3 2 0 10
## 16 336 0 0 0 2 0 4 1 0 8
## 17 372 0 1 0 3 0 5 1 0 6
## 18 382 0 1 1 3 0 5 2 0 7
## 19 388 0 2 0 3 0 4 2 0 10
## 20 393 0 1 1 3 0 5 2 0 6
## # … with 10 more variables: Fantasy <dbl>, `Film-Noir` <dbl>, Horror <dbl>,
## # Musical <dbl>, Mystery <dbl>, Romance <dbl>, `Sci-Fi` <dbl>,
## # Thriller <dbl>, War <dbl>, Western <dbl>, and abbreviated variable names
## # ¹Animation, ²`Children's`, ³Documentary
##
## [[4]]
## # A tibble: 20 × 20
## testUsers unknown Action Adventure Anima…¹ Child…² Comedy Crime Docum…³ Drama
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 4 0 3 3 3 0 3 1 0 8
## 2 62 0 2 0 3 0 5 2 1 8
## 3 79 0 0 1 2 0 5 0 1 8
## 4 90 0 2 0 3 0 4 1 0 7
## 5 98 0 1 0 0 0 1 3 0 11
## 6 101 0 2 0 0 0 4 2 1 10
## 7 103 0 5 3 3 0 4 0 0 6
## 8 111 0 1 1 1 0 3 1 0 8
## 9 133 0 1 1 2 0 5 1 0 6
## 10 149 0 1 0 3 0 5 1 0 7
## 11 184 0 2 2 2 0 1 2 0 9
## 12 214 0 2 2 1 0 4 2 0 9
## 13 270 0 1 0 0 0 4 0 0 8
## 14 284 0 1 0 3 0 5 1 0 5
## 15 326 0 2 0 3 0 4 2 0 9
## 16 336 0 0 0 2 0 4 1 0 7
## 17 372 0 1 0 3 0 4 1 0 7
## 18 382 0 2 1 3 0 5 2 0 7
## 19 388 0 2 0 3 0 3 2 0 11
## 20 393 0 1 1 3 0 4 2 0 6
## # … with 10 more variables: Fantasy <dbl>, `Film-Noir` <dbl>, Horror <dbl>,
## # Musical <dbl>, Mystery <dbl>, Romance <dbl>, `Sci-Fi` <dbl>,
## # Thriller <dbl>, War <dbl>, Western <dbl>, and abbreviated variable names
## # ¹Animation, ²`Children's`, ³Documentary
##
## [[5]]
## # A tibble: 20 × 20
## testUsers unknown Action Adventure Anima…¹ Child…² Comedy Crime Docum…³ Drama
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 4 0 4 3 1 5 7 2 0 5
## 2 62 0 4 1 1 0 4 0 1 6
## 3 79 0 2 1 0 0 4 3 0 7
## 4 90 0 1 1 1 4 2 1 0 8
## 5 98 0 4 4 0 1 3 2 0 4
## 6 101 0 3 0 1 1 5 1 0 4
## 7 103 0 3 2 1 3 5 3 0 4
## 8 111 0 1 2 0 1 6 2 0 6
## 9 133 0 4 4 0 1 4 0 0 7
## 10 149 0 2 2 1 2 8 1 0 4
## 11 184 0 3 1 1 0 6 3 0 3
## 12 214 0 4 1 0 0 4 0 0 6
## 13 270 0 3 3 1 1 4 0 0 6
## 14 284 0 3 3 2 1 5 1 0 6
## 15 326 0 5 1 0 0 5 1 0 5
## 16 336 0 2 2 1 3 6 0 0 5
## 17 372 0 2 3 1 2 2 1 0 8
## 18 382 0 3 2 0 0 7 1 0 3
## 19 388 0 2 3 0 4 5 1 0 4
## 20 393 0 2 2 1 1 6 0 0 3
## # … with 10 more variables: Fantasy <dbl>, `Film-Noir` <dbl>, Horror <dbl>,
## # Musical <dbl>, Mystery <dbl>, Romance <dbl>, `Sci-Fi` <dbl>,
## # Thriller <dbl>, War <dbl>, Western <dbl>, and abbreviated variable names
## # ¹Animation, ²`Children's`, ³Documentary
##
## [[6]]
## # A tibble: 20 × 20
## testUsers unknown Action Adventure Anima…¹ Child…² Comedy Crime Docum…³ Drama
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 4 0 0 1 3 1 3 2 1 7
## 2 62 0 0 0 1 0 6 0 0 10
## 3 79 0 4 1 1 1 5 2 1 9
## 4 90 0 1 1 0 0 5 2 0 8
## 5 98 0 4 0 1 2 7 0 0 6
## 6 101 0 1 2 0 1 5 0 0 7
## 7 103 0 0 0 1 1 2 1 0 12
## 8 111 0 3 5 2 1 5 1 0 3
## 9 133 0 2 0 1 1 3 2 0 10
## 10 149 0 0 0 1 2 4 0 0 10
## 11 184 0 1 1 2 2 1 0 1 8
## 12 214 0 4 4 0 1 6 1 0 7
## 13 270 0 3 3 1 1 0 0 0 8
## 14 284 0 5 4 2 1 3 1 0 6
## 15 326 0 4 2 0 1 1 1 0 8
## 16 336 0 0 1 2 1 5 1 0 7
## 17 372 0 2 1 0 0 1 2 0 9
## 18 382 0 2 1 2 1 8 0 0 5
## 19 388 0 0 0 1 1 5 2 0 9
## 20 393 0 0 1 1 1 4 1 0 5
## # … with 10 more variables: Fantasy <dbl>, `Film-Noir` <dbl>, Horror <dbl>,
## # Musical <dbl>, Mystery <dbl>, Romance <dbl>, `Sci-Fi` <dbl>,
## # Thriller <dbl>, War <dbl>, Western <dbl>, and abbreviated variable names
## # ¹Animation, ²`Children's`, ³Documentary
##
## [[7]]
## # A tibble: 20 × 20
## testUsers unknown Action Adventure Anima…¹ Child…² Comedy Crime Docum…³ Drama
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 4 0 0 0 3 0 4 1 0 9
## 2 62 0 0 0 2 0 4 1 0 7
## 3 79 0 0 0 3 0 4 1 0 9
## 4 90 0 0 0 1 0 2 1 0 9
## 5 98 0 0 0 1 0 3 1 0 9
## 6 101 0 0 0 3 0 4 1 0 8
## 7 103 0 0 0 1 0 2 1 0 9
## 8 111 0 0 0 2 0 3 1 0 9
## 9 133 0 0 0 3 0 4 1 0 8
## 10 149 0 0 0 3 0 3 1 0 7
## 11 184 0 0 0 3 0 4 1 0 9
## 12 214 0 0 0 3 0 4 1 0 9
## 13 270 0 0 0 3 0 4 1 0 9
## 14 284 0 0 0 3 0 4 1 0 9
## 15 326 0 0 0 3 0 4 1 0 8
## 16 336 0 0 0 3 0 4 1 0 9
## 17 372 0 0 0 3 0 4 1 0 9
## 18 382 0 0 0 3 0 4 1 0 9
## 19 388 0 0 0 2 0 3 1 0 8
## 20 393 0 0 0 3 0 4 1 0 8
## # … with 10 more variables: Fantasy <dbl>, `Film-Noir` <dbl>, Horror <dbl>,
## # Musical <dbl>, Mystery <dbl>, Romance <dbl>, `Sci-Fi` <dbl>,
## # Thriller <dbl>, War <dbl>, Western <dbl>, and abbreviated variable names
## # ¹Animation, ²`Children's`, ³Documentary
##
## [[8]]
## # A tibble: 20 × 20
## testUsers unknown Action Adventure Anima…¹ Child…² Comedy Crime Docum…³ Drama
## <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 4 0 0 0 3 0 4 1 0 9
## 2 62 0 0 0 2 0 3 1 0 9
## 3 79 0 0 0 3 0 4 1 1 7
## 4 90 0 0 0 1 0 2 1 0 9
## 5 98 0 0 0 1 0 3 1 0 9
## 6 101 0 0 0 3 0 4 1 0 7
## 7 103 0 0 0 1 0 2 1 0 9
## 8 111 0 0 0 2 0 3 1 0 9
## 9 133 0 0 0 3 0 4 1 0 8
## 10 149 0 0 0 3 0 3 1 0 7
## 11 184 0 0 0 3 0 4 1 0 9
## 12 214 0 0 0 3 0 4 1 0 8
## 13 270 0 0 0 3 0 4 1 0 9
## 14 284 0 0 0 3 0 4 1 0 9
## 15 326 0 0 0 3 0 4 1 0 8
## 16 336 0 0 0 3 0 4 1 0 9
## 17 372 0 0 0 3 0 5 1 0 8
## 18 382 0 0 0 3 0 4 1 0 9
## 19 388 0 0 0 2 0 3 1 0 8
## 20 393 0 0 0 3 0 4 1 1 8
## # … with 10 more variables: Fantasy <dbl>, `Film-Noir` <dbl>, Horror <dbl>,
## # Musical <dbl>, Mystery <dbl>, Romance <dbl>, `Sci-Fi` <dbl>,
## # Thriller <dbl>, War <dbl>, Western <dbl>, and abbreviated variable names
## # ¹Animation, ²`Children's`, ³DocumentaryDiese Auswertung stellt nun die Verteilung der top empfohlenen Genre fürs die einzelnen Kunden dar. Im ersten Dataframe wird ersichtlich, dass für User 4 viermal Action Filme empfohlen wurden. Drama Filme befanden sich gar 10 mal unter den Filmen.
10.3 Bestimme pro Kunde den Anteil nach Genres seiner Top-Filme
(=Filme mit besten Bewertungen),
topnmonitor_fav_movies <- MovieLenseEDA_Joined %>% filter(user %in% testUsers, rating == 5) %>% group_by(user) %>% summarise(across(c(unknown, Action, Adventure, Animation, `Children's`, Comedy, Crime, Documentary, Drama, Fantasy, `Film-Noir`, Horror, Musical, Mystery, Romance, `Sci-Fi`, Thriller, War, Western),sum)) %>% mutate(user = as.numeric(user)) %>% arrange(user)
topnmonitor_fav_moviesHierbei handelt es sich wieder um ein Resultat eines Tests.
get_fav_movies_by_genre <- function(users) {
fav_movies_by_genre <- MovieLenseEDA_Joined %>% filter(user %in% users, rating == 5) %>% group_by(user) %>% summarise(across(c(unknown, Action, Adventure, Animation, `Children's`, Comedy, Crime, Documentary, Drama, Fantasy, `Film-Noir`, Horror, Musical, Mystery, Romance, `Sci-Fi`, Thriller, War, Western),sum)) %>% mutate(user = as.numeric(user)) %>% arrange(user)
return(fav_movies_by_genre)
}
topnmonitor_fav_movies <- get_fav_movies_by_genre(testUsers)
topnmonitor_fav_moviesBei diesem Test der Funktion wurde wieder dasselbe Resultat generiert.
# iterate throguh both test_users_i
topnmonitor_fav_movies_1 <- get_fav_movies_by_genre(testUsers_1)
topnmonitor_fav_movies_1topnmonitor_fav_movies_2 <- get_fav_movies_by_genre(testUsers_2)
topnmonitor_fav_movies_2topnmonitor_fav_movies_list <- list(topnmonitor_fav_movies_1, topnmonitor_fav_movies_2)Diese Funktion hat nun die Top Genres der von den Usern bewerteten Filmen generiert. Im zweiten Dataframe ist ersichtlich, dass sieben von User 4 “gelikte” Filme vom Genre Action kommen.
10.4 Vergleiche pro Kunde Top-Empfehlungen vs Top-Filme nach Genres,
a <- topnmonitor_recom[1,2:20]
b <- topnmonitor_fav_movies[1,2:20]
binded <- rbind(a, b)
binded_complete <- binded %>% add_column(Type = c("topnmonitor_recom", "topnmonitor_fav_movies"))
binded_complete# pivot_longer binded_complete dataframe
binded_complete_pivot <- pivot_longer(binded_complete, cols = 1:19, names_to = "genre", values_to = "value")
binded_complete_pivot# create cleveland plot
ggplot(binded_complete_pivot, aes(y = genre, x = value)) +
geom_point(aes(color = Type)) +
geom_line(aes(group=genre)) +
theme_minimal() +
labs(title = "Top-N Empfehlungen vs Top-Filme nach Genres", x = "Value", y = "Genre") +
theme(plot.title = element_text(hjust = 0.5))
Hierbei handelt es sich wieder um einen Test für den Cleveland Plot.
create_cleveland_plot <- function(a, b, datatext, modeltext){
binded <- rbind(a, b)
binded_complete <- binded %>% add_column(Type = c("topnmonitor_recom", "topnmonitor_fav_movies"))
binded_complete_pivot <- pivot_longer(binded_complete, cols = 1:19, names_to = "genre", values_to = "value")
ggplot(binded_complete_pivot, aes(y = genre, x = value)) +
geom_point(aes(color = Type)) +
geom_line(aes(group=genre)) +
theme_minimal() +
labs(title = paste("Top-N Empfehlungen vs Top-Filme nach Genres mit Modell", modeltext, "für", datatext) , x = "Value", y = "Genre") +
theme(plot.title = element_text(hjust = 0.5))
}Diese Funktion generiert die Cleveland Plots.
#models und datensatz finden und zum titel hinzfuegen.
n_models <- list("IBCF", "UBCF", "SVD_3", "SVD_5")
n_dataset <- list("Datensatz 1", "Datensatz 2")
cnt <- 1
for (b_i in 1:length(n_dataset)) {
datatext_i <- n_dataset[b_i]
for (a_i in 1:length(n_models)) {
modeltext_i <- n_models[a_i]
b_df <- topnmonitor_fav_movies_list[[b_i]][1,2:20]
a_df <- top_n_list[[cnt]][1,2:20]
cnt <- cnt + 1
print(create_cleveland_plot(a_df, b_df, datatext_i, modeltext_i))
}
}
Es wurden nun 8 Cleveland Plots generiert. Vier für den ersten
reduzierten Datensatz und vier für den zweiten reduzierten Datensatz.
Die vier Plots pro Datensatz stehen für je eines der unterschiedlichen
Modelle. Dargestellt wird jeweils das Resultat des ersten Users pro
Datensatz. Im ersten Plot (IBCF für Datensatz 1) ist ersichtlich, dass
dem User 10mal Drama Filme empfohlen hat, während er selber sie nur 3mal
gelikt hat. Der schwarze Balken entspricht der Differenz.
Der visuelle Vergleich zwischen den beiden Datensätzen lässt den Schluss zu, dass bei beiden grosse Diskrepanzen zwischen den Empfehlungen und den tatsächlichen Likes bestehen.
10.5 Definiere eine Qualitätsmetrik für Top-N Listen und teste sie.
# testing
rowSums(topnmonitor_recom[2:20] * topnmonitor_fav_movies[2:20]) /
(sqrt(rowSums(topnmonitor_recom[2:20]^2))*sqrt(rowSums(topnmonitor_fav_movies[2:20]^2)))## [1] 0.9069238 0.5152888 0.6301260 0.7570982 0.8853280 0.8239333 0.8400269
## [8] 0.7133149 0.8489614 0.6425396 0.3520915 0.5471347 0.9303025 0.5251318
## [15] 0.7819307 0.9032992 0.0000000 0.3034885 0.8848772 0.8151546Hier handelt es sich um wiederum um einen Test.
cosine_10_2df <- function(df1, df2) {
cosine <- rowSums(df1[2:20] * df2[2:20]) /
(sqrt(rowSums(df1[2:20]^2))*sqrt(rowSums(df2[2:20]^2)))
return(cosine)
}
cnt <- 1
for (b_i in 1:length(n_dataset)) {
datatext_i <- n_dataset[b_i]
for (a_i in 1:length(n_models)) {
modeltext_i <- n_models[a_i]
b_df <- topnmonitor_fav_movies_list[[b_i]]
a_df <- top_n_list[[cnt]]
cnt <- cnt + 1
print(paste("Model:", modeltext_i, "fuer:", datatext_i))
print(cosine_10_2df(a_df, b_df))
}
}## [1] "Model: IBCF fuer: Datensatz 1"
## [1] 0.6935430 0.8455943 0.9021505 0.8883147 0.6367633 0.4698092 0.8401314
## [8] 0.6912801 0.6005326 0.7186270 0.7365998 0.7239256 0.8541691 0.7004148
## [15] 0.7998114 0.6647630 0.6591637 0.7677265 0.8826991 0.8451733
## [1] "Model: UBCF fuer: Datensatz 1"
## [1] 0.8582787 0.7131432 0.7765745 0.9219525 0.5300564 0.8314972 0.6639960
## [8] 0.3900120 0.5170877 0.7733603 0.7843665 0.9135536 0.7433708 0.7563788
## [15] 0.8659243 0.6220060 0.4728500 0.9133966 0.7486150 0.8489526
## [1] "Model: SVD_3 fuer: Datensatz 1"
## [1] 0.8027351 0.6950060 0.7682045 0.8002247 0.4414853 0.6504436 0.8117077
## [8] 0.8314794 0.4163455 0.6956249 0.9018489 0.9436578 0.8389933 0.7619048
## [15] 0.7436476 0.6797812 0.6419142 0.8550946 0.8008105 0.8300497
## [1] "Model: SVD_5 fuer: Datensatz 1"
## [1] 0.8027351 0.7111516 0.9022537 0.8448912 0.3033761 0.7145896 0.7700535
## [8] 0.8123624 0.4254570 0.6205052 0.8891479 0.9436578 0.8266660 0.7559289
## [15] 0.7581599 0.6804352 0.6610103 0.8879845 0.8096001 0.8306839
## [1] "Model: IBCF fuer: Datensatz 2"
## [1] 0.8678634 0.9050597 0.7011836 0.7616374 0.7817351 0.5529073 0.5668606
## [8] 0.7481320 0.7588051 0.4413833 0.7144856 0.9348218 0.8342001 0.7432423
## [15] 0.7911594 0.7642934 0.5416026 0.7576729 0.7210929 0.6929349
## [1] "Model: UBCF fuer: Datensatz 2"
## [1] 0.8711082 0.9610996 0.7221875 0.8493924 0.5805404 0.6216373 0.5318160
## [8] 0.7445007 0.5169973 0.7514691 0.8102991 0.8446167 0.7305575 0.6003573
## [15] 0.9433823 0.7701016 0.6432675 0.6768635 0.7163354 0.7994862
## [1] "Model: SVD_3 fuer: Datensatz 2"
## [1] 0.8281583 0.9379023 0.5643960 0.7717473 0.3305857 0.7681215 0.7852190
## [8] 0.7839878 0.3909129 0.8731283 0.8900629 0.7697752 0.8423966 0.8075135
## [15] 0.6931611 0.7098416 0.5373284 0.8077686 0.7994082 0.8344919
## [1] "Model: SVD_5 fuer: Datensatz 2"
## [1] 0.8281583 0.9413758 0.5780489 0.7717473 0.3305857 0.7177652 0.7852190
## [8] 0.7839878 0.3909129 0.8731283 0.8900629 0.7520047 0.8423966 0.8075135
## [15] 0.6931611 0.7098416 0.6114296 0.8077686 0.7994082 0.8273288Wir haben uns für die Qualitätsmetrik Cosine Similarity entschieden. Da wir pro User zwei Vektoren haben, ist dies eine geeignete Metrik, um die Top-N Liste und die Top-Filme des Kunden zu vergleichen. Für das Model IBCF und den Datensatz 1 wurde für den zweiten User eine Cosine Similarity von 0.85 berechnet. Die Übereinstimmung zwischen den Top-N empfohlenen Genres und den Top-Film-Genres des Kunden ist also relativ hoch. Im Gegensatz dazu ist beim sechsten User die Similarity lediglich 0.47 und die Übereinstimmung damit merkbar tiefer. Innerhalb des ersten Datensatzes sind die Similarities relativ hoch. Bei allen Modellen liegen die Werte grösstenteils über 0.7. Dies gilt auch für den zweiten Datensatz. Nach oben gehen die Werte bis fast 1 nach unten bis 0.4. Verglichen zwischen dem ersten und zweiten Datensatz, sind die Werte ebenfalls ähnlich. Wir haben zwar keine Auswertung berechnet, doch sind die Zahlen im gleichen, eher hohen, Bereich.